VAQEXT03 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL);01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Programmer entry point for manually rejecting PDX
;
N VAQPR,VAQAUDT,VAQSENPT,VAQAUSIT,VAQDZN,VAQDZ
N POP,DA,PARMNODE,FACDA,DOMDA
;
D:$D(XRTL) T0^%ZOSV
S VAQFLAG=1,POP=0
W !,"Working ..."
D PROCESS
I POP K XRT0 QUIT
W !!,"Manual process of entry queued "
D EXIT
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
QUIT
;
PROCESS ; -- Finds an entry in the 'PDX TRANSACTION' file
S X=VAQTRNO ; -- transaction to update (set in VAQEXT01)
S DIC="^VAT(394.61,",DIC(0)="MZ"
D ^DIC K DIC,X
I Y<0 S POP=1 W !,"Error...Transaction record not found" QUIT
S (VAQPR,DA)=+Y,VAQTRN=$P(Y,U,2)
D LOAD,UPDATE Q:POP
I $D(^TMP("CMNT",$J)) D CMNT
S VAQTRN(VAQPR)="" ; -- Load an array of processed manual transactions
; -- Updates workload file
S X=$$WORKDONE^VAQADS01($S(VAQST="REJ":"RJCT",VAQST="REL":"RLSE",VAQST="NFND":"UNKN",1:""),VAQPR,$G(DUZ))
QUIT
;
LOAD ; -- Loads the data for update
S %DT="ST",X="NOW" D ^%DT S VAQAUDT=Y ; -- date/time authori
K %DT,X,Y
S VAQSENPT=$$GETSEN^VAQUTL97(DFN) ; -- sensative patient
S:VAQSENPT<0 VAQSENPT=""
;
S PARMNODE=$G(^VAT(394.81,1,0))
S FACDA=$P(PARMNODE,U,1),DOMDA=$P(PARMNODE,U,2)
S VAQAUSIT=$P($G(^DIC(4,FACDA,0)),U,1) ; -- authori site
S VAQAUADD=$P($G(^DIC(4.2,DOMDA,0)),U,1) ; -- authori addr
;
S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
S VAQDZ=$S($D(DUZ):DUZ,1:"") ; -- authorizer
QUIT
;
UPDATE ; -- Sets DR string and non-constant variables for update
S DR=".05///"_$S(VAQST="REJ":"VAQ-REJ",VAQST="REL":"VAQ-RSLT",VAQST="NFND":"VAQ-NTFND",1:"")
I (DFN>0) S DR(1,394.61,.03)=".03////"_DFN ; -- local patient pointer
S DR(1,394.61,.04)=".04///"_VAQSENPT
;S DR(1,394.61,.05)=".05///"_$S(VAQST="REJ":"VAQ-REJ",VAQST="REL":"VAQ-RSLT",VAQST="NFND":"VAQ-NTFND",1:"")
S DR(1,394.61,50)="50///"_VAQAUDT
S DR(1,394.61,51)="51///"_VAQDZN
;S DR(1,394.61,60)="60///"_VAQAUSIT
;S DR(1,394.61,61)="61///"_VAQAUADD
;
S DIE="^VAT(394.61,"
L +(@(DIE_DA_")")):60
I ('$T) S POP=1 W !,"Could not edit entry... locked by other user)" QUIT
D ^DIE
L -(@(DIE_DA_")"))
K DIE,DR
QUIT
;
CMNT ; -- Loads comment for manual process reject or release (WORD PROCESSOR FIELD)
S %X="^TMP(""CMNT"",$J,"
S %Y="^VAT(394.61,"_DA_",""CMNT"","
D %XY^%RCR
K %X,%Y,^TMP("CMNT",$J)
QUIT
;
EXIT ; -- Cleans up local variables
K VAQPR,VAQAUDT,VAQSENPT,VAQAUSIT,VAQDZN,VAQDZ
K POP,DA,PARMNODE,FACDA,DOMDA
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQEXT03 2579 printed Apr 09, 2024@21:27:51 Page 2
VAQEXT03 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL);01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Programmer entry point for manually rejecting PDX
+1 ;
+2 NEW VAQPR,VAQAUDT,VAQSENPT,VAQAUSIT,VAQDZN,VAQDZ
+3 NEW POP,DA,PARMNODE,FACDA,DOMDA
+4 ;
+5 if $DATA(XRTL)
DO T0^%ZOSV
+6 SET VAQFLAG=1
SET POP=0
+7 WRITE !,"Working ..."
+8 DO PROCESS
+9 IF POP
KILL XRT0
QUIT
+10 WRITE !!,"Manual process of entry queued "
+11 DO EXIT
+12 if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+13 QUIT
+14 ;
PROCESS ; -- Finds an entry in the 'PDX TRANSACTION' file
+1 ; -- transaction to update (set in VAQEXT01)
SET X=VAQTRNO
+2 SET DIC="^VAT(394.61,"
SET DIC(0)="MZ"
+3 DO ^DIC
KILL DIC,X
+4 IF Y<0
SET POP=1
WRITE !,"Error...Transaction record not found"
QUIT
+5 SET (VAQPR,DA)=+Y
SET VAQTRN=$PIECE(Y,U,2)
+6 DO LOAD
DO UPDATE
if POP
QUIT
+7 IF $DATA(^TMP("CMNT",$JOB))
DO CMNT
+8 ; -- Load an array of processed manual transactions
SET VAQTRN(VAQPR)=""
+9 ; -- Updates workload file
+10 SET X=$$WORKDONE^VAQADS01($SELECT(VAQST="REJ":"RJCT",VAQST="REL":"RLSE",VAQST="NFND":"UNKN",1:""),VAQPR,$GET(DUZ))
+11 QUIT
+12 ;
LOAD ; -- Loads the data for update
+1 ; -- date/time authori
SET %DT="ST"
SET X="NOW"
DO ^%DT
SET VAQAUDT=Y
+2 KILL %DT,X,Y
+3 ; -- sensative patient
SET VAQSENPT=$$GETSEN^VAQUTL97(DFN)
+4 if VAQSENPT<0
SET VAQSENPT=""
+5 ;
+6 SET PARMNODE=$GET(^VAT(394.81,1,0))
+7 SET FACDA=$PIECE(PARMNODE,U,1)
SET DOMDA=$PIECE(PARMNODE,U,2)
+8 ; -- authori site
SET VAQAUSIT=$PIECE($GET(^DIC(4,FACDA,0)),U,1)
+9 ; -- authori addr
SET VAQAUADD=$PIECE($GET(^DIC(4.2,DOMDA,0)),U,1)
+10 ;
+11 SET VAQDZN=$SELECT($DATA(DUZ):$PIECE(^VA(200,DUZ,0),U,1),1:"")
+12 ; -- authorizer
SET VAQDZ=$SELECT($DATA(DUZ):DUZ,1:"")
+13 QUIT
+14 ;
UPDATE ; -- Sets DR string and non-constant variables for update
+1 SET DR=".05///"_$SELECT(VAQST="REJ":"VAQ-REJ",VAQST="REL":"VAQ-RSLT",VAQST="NFND":"VAQ-NTFND",1:"")
+2 ; -- local patient pointer
IF (DFN>0)
SET DR(1,394.61,.03)=".03////"_DFN
+3 SET DR(1,394.61,.04)=".04///"_VAQSENPT
+4 ;S DR(1,394.61,.05)=".05///"_$S(VAQST="REJ":"VAQ-REJ",VAQST="REL":"VAQ-RSLT",VAQST="NFND":"VAQ-NTFND",1:"")
+5 SET DR(1,394.61,50)="50///"_VAQAUDT
+6 SET DR(1,394.61,51)="51///"_VAQDZN
+7 ;S DR(1,394.61,60)="60///"_VAQAUSIT
+8 ;S DR(1,394.61,61)="61///"_VAQAUADD
+9 ;
+10 SET DIE="^VAT(394.61,"
+11 LOCK +(@(DIE_DA_")")):60
+12 IF ('$TEST)
SET POP=1
WRITE !,"Could not edit entry... locked by other user)"
QUIT
+13 DO ^DIE
+14 LOCK -(@(DIE_DA_")"))
+15 KILL DIE,DR
+16 QUIT
+17 ;
CMNT ; -- Loads comment for manual process reject or release (WORD PROCESSOR FIELD)
+1 SET %X="^TMP(""CMNT"",$J,"
+2 SET %Y="^VAT(394.61,"_DA_",""CMNT"","
+3 DO %XY^%RCR
+4 KILL %X,%Y,^TMP("CMNT",$JOB)
+5 QUIT
+6 ;
EXIT ; -- Cleans up local variables
+1 KILL VAQPR,VAQAUDT,VAQSENPT,VAQAUSIT,VAQDZN,VAQDZ
+2 KILL POP,DA,PARMNODE,FACDA,DOMDA
+3 QUIT
+4 ;
END ; -- End of code
+1 QUIT
