VAQDIS01 ;ALB/JFP - DISPLAY MINIMAL DATA, DRIVER ;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
;
PT S VAQTYPE="PT" G EP1 ; -- Minimal data extracted from ^DPT(2,
TR S VAQTYPE="TR" G EP1 ; -- Minimal data extracted from ^VAT(394.62,
;
EP1 D EN^VALM("VAQ DISPLAY MINIMUM") ; -- Protocol = VAQ DIS1 (MENU)
QUIT
;
INIT ; -- Builds array of minimal data for the patient entered (DFN)
;W !,"DFN = ",DFN
K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
N ROOT,SEGPTR,X,MSG,VAQIGNC,XTRCT,OFFSET
S (VAQADFL,ERRPOP,VALMCNT)=0
;
S ROOT="^TMP(""VAQDIS"",$J)"
S SEGPTR=$O(^VAT(394.71,"C","PDX*MIN",""))
S VAQIGNC=1 ; -- turns of encryption
I VAQTYPE="PT" D
.D CHGCAP^VALM("LOCAL"," Local Patient Data")
.S X=$$SEGXTRCT^VAQDBI(0,DFN,ROOT,SEGPTR)
I VAQTYPE="TR" D
.D CHGCAP^VALM("LOCAL"," Remote Patient Data")
.S X=$$SEGEXT^VAQUPD1(DFN,SEGPTR,ROOT)
I +X=-1 D QUIT
.S MSG="Extract not successful...Error: "_$P(X,U,2)
.S X=$$SETSTR^VALM1(" ","",1,79) D TMP
.S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
.S ERRPOP=1
; -- extraction sucessful, call display load
S XTRCT=ROOT
S ROOT="^TMP(""VAQD1"",$J)"
S (OFFSET,DSP)=0
S X=$$DISPMIN^VAQDIS21(XTRCT,SEGPTR,ROOT,OFFSET,DSP)
I +X=-1 D QUIT
.S MSG="Display load not successful...Error: "_$P(X,U,2)
.S X=$$SETSTR^VALM1(" ","",1,79) D TMP
.S X=$$SETSTR^VALM1(MSG,"",1,80) D TMP
.S ERRPOP=1
S VALMBCK="Q"
QUIT
;
TMP ; -- Set the array used by list processor
S VALMCNT=VALMCNT+1
S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
QUIT
;
HD ; -- Make header line for list processor
D HD1^VAQEXT02 QUIT
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
;
K ^TMP("VAQD1",$J),^TMP("VAQDIS",$J)
K VAQTYPE,VAQIGNC
K ROOT,SEGPTR,X,MSG,XTRCT,OFFSET,DSP,ERRPOP
Q
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS01 1908 printed Sep 23, 2025@20:00:56 Page 2
VAQDIS01 ;ALB/JFP - DISPLAY MINIMAL DATA, DRIVER ;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 ;
PT ; -- Minimal data extracted from ^DPT(2,
SET VAQTYPE="PT"
GOTO EP1
TR ; -- Minimal data extracted from ^VAT(394.62,
SET VAQTYPE="TR"
GOTO EP1
+1 ;
EP1 ; -- Protocol = VAQ DIS1 (MENU)
DO EN^VALM("VAQ DISPLAY MINIMUM")
+1 QUIT
+2 ;
INIT ; -- Builds array of minimal data for the patient entered (DFN)
+1 ;W !,"DFN = ",DFN
+2 KILL ^TMP("VAQD1",$JOB),^TMP("VAQDIS",$JOB)
+3 NEW ROOT,SEGPTR,X,MSG,VAQIGNC,XTRCT,OFFSET
+4 SET (VAQADFL,ERRPOP,VALMCNT)=0
+5 ;
+6 SET ROOT="^TMP(""VAQDIS"",$J)"
+7 SET SEGPTR=$ORDER(^VAT(394.71,"C","PDX*MIN",""))
+8 ; -- turns of encryption
SET VAQIGNC=1
+9 IF VAQTYPE="PT"
Begin DoDot:1
+10 DO CHGCAP^VALM("LOCAL"," Local Patient Data")
+11 SET X=$$SEGXTRCT^VAQDBI(0,DFN,ROOT,SEGPTR)
End DoDot:1
+12 IF VAQTYPE="TR"
Begin DoDot:1
+13 DO CHGCAP^VALM("LOCAL"," Remote Patient Data")
+14 SET X=$$SEGEXT^VAQUPD1(DFN,SEGPTR,ROOT)
End DoDot:1
+15 IF +X=-1
Begin DoDot:1
+16 SET MSG="Extract not successful...Error: "_$PIECE(X,U,2)
+17 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP
+18 SET X=$$SETSTR^VALM1(MSG,"",1,80)
DO TMP
+19 SET ERRPOP=1
End DoDot:1
QUIT
+20 ; -- extraction sucessful, call display load
+21 SET XTRCT=ROOT
+22 SET ROOT="^TMP(""VAQD1"",$J)"
+23 SET (OFFSET,DSP)=0
+24 SET X=$$DISPMIN^VAQDIS21(XTRCT,SEGPTR,ROOT,OFFSET,DSP)
+25 IF +X=-1
Begin DoDot:1
+26 SET MSG="Display load not successful...Error: "_$PIECE(X,U,2)
+27 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP
+28 SET X=$$SETSTR^VALM1(MSG,"",1,80)
DO TMP
+29 SET ERRPOP=1
End DoDot:1
QUIT
+30 SET VALMBCK="Q"
+31 QUIT
+32 ;
TMP ; -- Set the array used by list processor
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQD1",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 QUIT
+4 ;
HD ; -- Make header line for list processor
+1 DO HD1^VAQEXT02
QUIT
+2 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 ;
+3 KILL ^TMP("VAQD1",$JOB),^TMP("VAQDIS",$JOB)
+4 KILL VAQTYPE,VAQIGNC
+5 KILL ROOT,SEGPTR,X,MSG,XTRCT,OFFSET,DSP,ERRPOP
+6 QUIT
+7 ;
END ; -- End of code
+1 QUIT
