- 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 Feb 18, 2025@23:51:19 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