190 lines
6.0 KiB
Mathematica
190 lines
6.0 KiB
Mathematica
PXKMAIN1 ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;5/6/1999
|
|
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,124,178**;Aug 12, 1996
|
|
;+This routine is responsible for:
|
|
;+ - creating new entries in PCE files,
|
|
;+ - processing modifications to existing entries,
|
|
;+ - deleting entries,
|
|
;+ - ensuring all required variables are present,
|
|
;+ - setting both Audit fields (EDITED FLAG and AUDIT TRAIL),
|
|
;+ - checking for duplicate entries,
|
|
;+ - some error reporting.
|
|
;+
|
|
;+LOCAL VARIABLE LIST
|
|
;+ MOST VARIABLES ARE DEFINED AT THE TOP OF PXKMAIN
|
|
;+ PXKSEQ = Sequence number in PXK tmp global
|
|
;+ PXKCAT = Category of entry (CPT,MSR,VST...)
|
|
;+ PXKREF = Root of temp global
|
|
;+ PXKPIEN = IEN of v file
|
|
;+ PXKAUDIT = data located in the audit field of the v file
|
|
;+ PXKER = field data use to build the dr string (eg .04///^S X=$G()
|
|
;+ PXKFLD = field number gleened from the file routines
|
|
;+ PXKNOD = same as the subscript in a global node
|
|
;+ PXKPCE = the piece where the data is found on that node
|
|
;
|
|
;
|
|
W !,"This is not an entry point" Q
|
|
LOOP ;+Copy delimited strings into sub-arrays.
|
|
F PXKI=1:1:$L(PXKAFT(PXKSUB),"^") I $P(PXKAFT(PXKSUB),"^",PXKI)'="" S PXKAV(PXKSUB,PXKI)=$P(PXKAFT(PXKSUB),"^",PXKI)
|
|
F PXKI=1:1:$L(PXKBEF(PXKSUB),"^") I $P(PXKBEF(PXKSUB),"^",PXKI)'="" S PXKBV(PXKSUB,PXKI)=$P(PXKBEF(PXKSUB),"^",PXKI)
|
|
K PXKI,PXKJ ; Not sure if NEW would be OK.
|
|
I PXKCAT="CPT",PXKSUB=1 D LOOP^PXKMOD
|
|
Q
|
|
;
|
|
ERROR ;+Check for missing required fields
|
|
Q:$G(PXKAV(0,1))["@"!('$D(PXKAV(0,1)))
|
|
S PXKNOD=0,PXKPCE=0
|
|
D EN1^@PXKRTN
|
|
S PXKER=$P(PXKER," * ",1)
|
|
I PXKER="" Q
|
|
F PXJ=1:1:$L(PXKER,",") D
|
|
. S PXJJ=$P(PXKER,",",PXJ)
|
|
. I '$D(PXKAV(PXKNOD,PXJJ)) D
|
|
. . S PXKPCE=PXJJ
|
|
. . D EN2^@PXKRTN
|
|
. . S PXKFLD=$P(PXKFD,"/",1)
|
|
. . S:PXKFLD["*" PXKFLD=$P(PXKFLD," * ",2)
|
|
. . S PXKERROR(PXKCAT,PXKSEQ,0,PXKFLD)="Missing Required Fields"
|
|
K PXK,PXJJ,PXKFLD,PXKFD ; Not sure about use of NEW here.
|
|
Q
|
|
;
|
|
CLEAN ;--Clean out the PXKAV array
|
|
S PXKJ=""
|
|
F S PXKJ=$O(PXKBV(PXKJ)) Q:PXKJ="" D
|
|
. S PXKI=""
|
|
. F S PXKI=$O(PXKBV(PXKJ,PXKI)) Q:PXKI="" D
|
|
. . I $G(PXKBV(PXKJ,PXKI))=$G(PXKAV(PXKJ,PXKI)) K PXKAV(PXKJ,PXKI)
|
|
K PXKI,PXKJ ; Not sure about NEW here.
|
|
Q
|
|
;
|
|
FILE ;+Create a new entry in file and get IEN
|
|
;+This is the code that adds new entries to V-files
|
|
;+and to the Visit file.
|
|
K DD,DO
|
|
S DIC=$P($T(GLOBAL^@PXKRTN),";;",2)_"("
|
|
S DIC(0)=""
|
|
S X=$G(PXKAV(0,1))
|
|
D FILE^DICN
|
|
S (PXKPIEN,DA)=+Y
|
|
S DR=""
|
|
K DIC,Y,X
|
|
Q
|
|
;
|
|
AUD12 ;--Set both audit fields
|
|
S DR=""
|
|
S PXKAUDIT=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA,801)"
|
|
S PXKAUDIT=$P($G(@PXKAUDIT),"^",2)_PXKSORR_";"
|
|
I $L(PXKAUDIT,";")>5 S $P(PXKAUDIT,";",2,$L(PXKAUDIT,";"))="+;"_$P(PXKAUDIT,";",4,$L(PXKAUDIT,";")) ;PX*1*124 Change 8 to 5
|
|
S PXKNOD=801
|
|
S DR=""
|
|
F PXKPCE=1,2 D EN1^@PXKRTN S DR=DR_PXKER
|
|
S PXKFVDLM=""
|
|
Q
|
|
;
|
|
AUD2 ;--Set second audit fields
|
|
S DR=""
|
|
S PXKAUDIT=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA,801)"
|
|
S PXKAUDIT=$P($G(@PXKAUDIT),"^",2)_PXKSORR_";"
|
|
I $L(PXKAUDIT,";")>5 S $P(PXKAUDIT,";",2,$L(PXKAUDIT,";"))="+;"_$P(PXKAUDIT,";",4,$L(PXKAUDIT,";")) ;PX*1*124 Change 8 to 5
|
|
S PXKNOD=801
|
|
S DR=""
|
|
S PXKPCE=2
|
|
D EN1^@PXKRTN
|
|
S DR=DR_PXKER
|
|
S PXKFVDLM=""
|
|
Q
|
|
;
|
|
DRDIE ;--Set the DR string and DO DIE
|
|
I PXKCAT="VST" D UPD^PXKFVST Q
|
|
S DIE=$P($T(GLOBAL^@PXKRTN),";;",2)_"(" K PXKPTR
|
|
S PXKLR=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA)"
|
|
S PXKNOD=""
|
|
F S PXKNOD=$O(PXKAV(PXKNOD)) Q:PXKNOD="" D
|
|
. I PXKFGAD=1,PXKNOD=0 S PXKPCE=1 D
|
|
.. Q:PXKCAT'="CPT"
|
|
.. I $G(^TMP("PXK",$J,PXKCAT,PXKSEQ,"IEN"))=PXKPIEN S PXKPCE=3
|
|
. I PXKFGAD=1,PXKNOD'=0 S PXKPCE=0
|
|
. I PXKFGED=1 S PXKPCE=0
|
|
. I PXKCAT="CPT",PXKNOD=1 D Q
|
|
.. D DIE
|
|
.. I $G(^TMP("PXK",$J,PXKCAT,PXKSEQ,"IEN"))]"" Q
|
|
.. D UPD^PXKMOD
|
|
. F S PXKPCE=$O(PXKAV(PXKNOD,PXKPCE)) Q:PXKPCE="" D
|
|
..D EN1^@PXKRTN
|
|
..I $G(PXKER)'="" D
|
|
...I PXKER["~" D
|
|
....I $P(PXKER,"~",2)["A",PXKFGAD=1 S PXKER=$P(PXKER,"~") Q
|
|
....I $P(PXKER,"~",2)'["A",PXKFGAD=1 S PXKER="" Q
|
|
....I $P(PXKER,"~",2)["E",PXKFGED=1 S PXKER=$P(PXKER,"~") Q
|
|
....I $P(PXKER,"~",2)'["E",PXKFGED=1 S PXKER="" Q
|
|
...I +PXKER=0 D
|
|
....I PXKAV(PXKNOD,PXKPCE)=+PXKAV(PXKNOD,PXKPCE) S PXKER=$P(PXKER," * ",2)
|
|
....I PXKAV(PXKNOD,PXKPCE)'=+PXKAV(PXKNOD,PXKPCE) S PXKER=$P(PXKER," * ",3),PXKPTR(PXKPIEN,PXKNOD,PXKPCE)=""
|
|
..I $G(PXKER)'="" S DR=DR_PXKER_"PXKAV("_PXKNOD_","_PXKPCE_"));"
|
|
..I $L(DR)>200 D DIE
|
|
D DIE
|
|
K DIE,PXKLR,DIC(0)
|
|
D ER
|
|
Q
|
|
DIE ;+Lock global and invoke FM ^DIE call.
|
|
L +@PXKLR:10
|
|
D ^DIE
|
|
L -@PXKLR
|
|
K DR
|
|
S DR=""
|
|
Q
|
|
;
|
|
DELETE ;+Use FM ^DIK call to delete entry identified by PXKPIEN.
|
|
S DA=PXKPIEN
|
|
S DIK=$P($T(GLOBAL^@PXKRTN),";;",2)_"("
|
|
D ^DIK
|
|
K DIK
|
|
Q
|
|
;
|
|
DUP ;+Code to check for duplicates
|
|
I PXKCAT="VST" Q
|
|
I PXKCAT="CPT" Q
|
|
I PXKCAT="HF" Q
|
|
N PXKRTN
|
|
I '$D(PXKPIEN) N PXKPIEN S PXKPIEN=""
|
|
S PXKNOD=0
|
|
S PXKPCE=0
|
|
S PXKRTN="PXKF"_PXKVCAT
|
|
S PXKVRTN=$P($T(GLOBAL^@PXKRTN),";;",2)
|
|
S PXJJJ=0
|
|
D EN1^@PXKRTN
|
|
I $P(PXKER," * ",3)'=0 D
|
|
.S PXKER=$P(PXKER," * ",2)
|
|
.I PXKER="" Q
|
|
.S (PX,PXFG)=0
|
|
.F S PX=$O(@PXKVRTN@("AD",PXKVST,PX)) Q:PX="" D Q:PXFG=1
|
|
..S PXJJJ=0
|
|
..F PXJ=1:1:$L(PXKER,",") S PXJJ=$P(PXKER,",",PXJ) D
|
|
...I $P($G(@PXKVRTN@(PX,$P(PXJJ,"+",1))),"^",$P(PXJJ,"+",2))=$G(PXKAV($P(PXJJ,"+",1),$P(PXJJ,"+",2))),PX'=PXKPIEN S PXJJJ=PXJJJ+1
|
|
..I $L(PXKER,",")=PXJJJ S PXFG=1
|
|
;PXKHLR Is not killed because it is a flag comming from another routine
|
|
Q
|
|
;
|
|
ER ;--PXKERROR MAKING IF NOT POPULATED CORRECTLY
|
|
N PXKRT,PXKMOD,PXKSTR
|
|
S PXKMOD=PXKSEQ#1 I $G(PXKMOD) Q
|
|
S PXKN=""
|
|
F S PXKN=$O(PXKAV(PXKN)) Q:PXKN="" D
|
|
. S PXKP=""
|
|
. F S PXKP=$O(PXKAV(PXKN,PXKP)) Q:PXKP="" D
|
|
.. S PXKRRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_DA_","
|
|
.. I PXKN=1,PXKCAT="CPT" S PXKRRT=PXKRRT_PXKN_","_PXKP_","_0_")"
|
|
.. E S PXKRRT=PXKRRT_PXKN_")"
|
|
.. I PXKAV(PXKN,PXKP)'=$P($G(@PXKRRT),"^",$S(PXKN=1:1,1:PXKP)) D
|
|
... Q:PXKAV(PXKN,PXKP)["@"
|
|
... S PXKNOD=PXKN,PXKPCE=PXKP
|
|
... I PXKNOD=1,PXKCAT="CPT" S PXKPCE=1
|
|
... D EN2^@PXKRTN
|
|
... S PXKFLD=$P(PXKFD,"/",1)
|
|
... S:PXKFLD["*" PXKFLD=$P(PXKFLD," * ",2)
|
|
... Q:PXKFLD=1101
|
|
... S PXKSTR="Not Stored = "_PXKAV(PXKN,PXKP)
|
|
... I $G(PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD))]"" D
|
|
.... S PXKSTR=PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD)_","_PXKAV(PXKN,PXKP)
|
|
... S PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD)=PXKSTR
|
|
Q
|