VAQDIS01.m

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 ---VAQDIS01   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