VAQEXT02.m

VAQEXT02 ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93

 ;;1.5;PATIENT DATA EXCHANGE;**1,10,14**;NOV 17, 1993

EP ; -- Main entry point for the list processor

 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)

 D EN^VALM("VAQ PROCESS PDX4")

 N VALMCNT S VALMCNT=0

 QUIT

 ;

INIT ; -- Builds array of Patients based on PDX transactions for manual

 ;    processing

 ;

 K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)

 N VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT

 N VADM,VA,VAERR

 ;

 S (VAQECNT,VALMCNT)=0,(VAQDFN,DFN)=""

 F  S DFN=$O(DPTD(DFN)) Q:DFN=""  D

 .S VAQECNT=VAQECNT+1

 .D DEM^VADPT

 .S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")

 .S X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")

 .S X=$$SETFLD^VALM1($P(VADM(2),U,2),X,"SSN")

 .S VA("DOB")=$$DOBFMT^VAQUTL99($P(VADM(3),U,1))

 .S X=$$SETFLD^VALM1(VA("DOB"),X,"DOB")

 .S X=$$SETFLD^VALM1(VA("PID"),X,"PID")

 .D TMP

 QUIT

 ;

TMP ; -- Set the array used by list processor

 S VALMCNT=VALMCNT+1

 S ^TMP("VAQR4",$J,VALMCNT,0)=$E(X,1,79)

 S ^TMP("VAQR4",$J,"IDX",VALMCNT,VAQECNT)=""

 S ^TMP("VAQR4","VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRDE_"^"_DFN

 Q

 ;

HD ; -- Make header line for list processor

 Q:'$D(VALMY)

HD1 N X,SP50

 S SP50=$J("",50)

 S X=$$SETSTR^VALM1("Remote Patient: "_VAQPTNM,"",1,41)

 S:VAQPTID="" X=$$SETSTR^VALM1("SSN: "_VAQESSN,X,42,17)

 S:VAQPTID'="" X=$$SETSTR^VALM1(" ID: "_VAQPTID,X,42,17)

 S X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,59,20)

 S VALMHDR(1)=" "

 S VALMHDR(2)=X

 S VALMHDR(3)=" "

 QUIT

 ;

REJ ; -- Reject PDX with comment

 S VAQST="REJ",VAQFLAG=0,VAQCMNT="Reject "

 D CLEAR^VALM1

 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature

 I VAQSIG<0 K VAQSIG D TRANEX  QUIT

 D EP^VAQREQ08 ; -- Comment for reject

 D EP^VAQEXT03

 D TRANEX

 QUIT

 ;

REL ;  -- Release PDX with comment

 D SEL^VALM2

 Q:'$D(VALMY)

 N ENT S ENT=$O(VALMY(""))

 S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)

 S VAQFLAG=0,VAQST="REL",VAQCMNT="Release "

 D CLEAR^VALM1

 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature

 I VAQSIG<0 K VAQSIG D TRANEX  QUIT

 D EP^VAQREQ08 ; -- Comment for reject

 D EP^VAQEXT03 ; --

 D TRANEX

 QUIT

 ;

NFND ; -- Not found (reject)

 D CLEAR^VALM1 ;clears screen

 S DIR(0)="Y",DIR("B")="YES"

 S DIR("A")="Requested patient not found...Process as not found"

 D ^DIR K DIR

 I ('Y)!($D(DUOUT))!($D(DTOUT)) S VALMBCK="Q"  QUIT

 S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) ; -- Signature

 I VAQSIG<0 K VAQSIG D TRANEX  QUIT

 S:'$D(DFN) DFN=""

 S VAQST="NFND"

 D:Y EP^VAQEXT03

 D TRANEX

 QUIT

 ;

EXP ; -- Expand entry

 D SEL^VALM2

 Q:'$D(VALMY)

 N ENT S ENT=$O(VALMY(""))

 S DFN=$P(^TMP("VAQR4","VAQIDX",$J,ENT),"^",3)

 D EP^VAQDIS01

 S VALMBCK="R"

 QUIT

 ;

TRANEX ; -- Pauses screen

 D PAUSE^VAQUTL95

 S:'$D(VAQFLAG) VAQFLAG=""

 S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")

 QUIT

 ;

EXIT ; -- Note: The list processor cleans up its own variables.

 ;          All other variables cleaned up here.

 ;

 K ^TMP("VAQR4",$J),^TMP("VAQR4","VAQIDX",$J)

 K VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT

 K VALMCNT,VADM,SP50,DFN

 Q

 ;

END ; -- End of code

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQEXT02   3144     printed  Feb 18, 2025@23:51:43                                                                                                                                                                                                    Page 2

VAQEXT02  ;ALB/JFP - PDX, PROCESS EXTERNAL (MANUAL),PROCESS SCREEN;01MAR93

 +1       ;;1.5;PATIENT DATA EXCHANGE;**1,10,14**;NOV 17, 1993

EP        ; -- Main entry point for the list processor

 +1       ; -- K XQORS,VALMEVL ;(only kill on the first screen in)

 +2        DO EN^VALM("VAQ PROCESS PDX4")

 +3        NEW VALMCNT

           SET VALMCNT=0

 +4        QUIT 

 +5       ;

INIT      ; -- Builds array of Patients based on PDX transactions for manual

 +1       ;    processing

 +2       ;

 +3        KILL ^TMP("VAQR4",$JOB),^TMP("VAQR4","VAQIDX",$JOB)

 +4        NEW VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT

 +5        NEW VADM,VA,VAERR

 +6       ;

 +7        SET (VAQECNT,VALMCNT)=0

           SET (VAQDFN,DFN)=""

 +8        FOR 

               SET DFN=$ORDER(DPTD(DFN))

               if DFN=""

                   QUIT 

               Begin DoDot:1

 +9                SET VAQECNT=VAQECNT+1

 +10               DO DEM^VADPT

 +11               SET X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")

 +12               SET X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")

 +13               SET X=$$SETFLD^VALM1($PIECE(VADM(2),U,2),X,"SSN")

 +14               SET VA("DOB")=$$DOBFMT^VAQUTL99($PIECE(VADM(3),U,1))

 +15               SET X=$$SETFLD^VALM1(VA("DOB"),X,"DOB")

 +16               SET X=$$SETFLD^VALM1(VA("PID"),X,"PID")

 +17               DO TMP

               End DoDot:1

 +18       QUIT 

 +19      ;

TMP       ; -- Set the array used by list processor

 +1        SET VALMCNT=VALMCNT+1

 +2        SET ^TMP("VAQR4",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)

 +3        SET ^TMP("VAQR4",$JOB,"IDX",VALMCNT,VAQECNT)=""

 +4        SET ^TMP("VAQR4","VAQIDX",$JOB,VAQECNT)=VALMCNT_"^"_VAQTRDE_"^"_DFN

 +5        QUIT 

 +6       ;

HD        ; -- Make header line for list processor

 +1        if '$DATA(VALMY)

               QUIT 

HD1        NEW X,SP50

 +1        SET SP50=$JUSTIFY("",50)

 +2        SET X=$$SETSTR^VALM1("Remote Patient: "_VAQPTNM,"",1,41)

 +3        if VAQPTID=""

               SET X=$$SETSTR^VALM1("SSN: "_VAQESSN,X,42,17)

 +4        if VAQPTID'=""

               SET X=$$SETSTR^VALM1(" ID: "_VAQPTID,X,42,17)

 +5        SET X=$$SETSTR^VALM1(" DOB: "_VAQEDOB,X,59,20)

 +6        SET VALMHDR(1)=" "

 +7        SET VALMHDR(2)=X

 +8        SET VALMHDR(3)=" "

 +9        QUIT 

 +10      ;

REJ       ; -- Reject PDX with comment

 +1        SET VAQST="REJ"

           SET VAQFLAG=0

           SET VAQCMNT="Reject "

 +2        DO CLEAR^VALM1

 +3       ; -- Signature

           if '$DATA(VAQSIG)

               SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)

 +4        IF VAQSIG<0

               KILL VAQSIG

               DO TRANEX

               QUIT 

 +5       ; -- Comment for reject

           DO EP^VAQREQ08

 +6        DO EP^VAQEXT03

 +7        DO TRANEX

 +8        QUIT 

 +9       ;

REL       ;  -- Release PDX with comment

 +1        DO SEL^VALM2

 +2        if '$DATA(VALMY)

               QUIT 

 +3        NEW ENT

           SET ENT=$ORDER(VALMY(""))

 +4        SET DFN=$PIECE(^TMP("VAQR4","VAQIDX",$JOB,ENT),"^",3)

 +5        SET VAQFLAG=0

           SET VAQST="REL"

           SET VAQCMNT="Release "

 +6        DO CLEAR^VALM1

 +7       ; -- Signature

           if '$DATA(VAQSIG)

               SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)

 +8        IF VAQSIG<0

               KILL VAQSIG

               DO TRANEX

               QUIT 

 +9       ; -- Comment for reject

           DO EP^VAQREQ08

 +10      ; --

           DO EP^VAQEXT03

 +11       DO TRANEX

 +12       QUIT 

 +13      ;

NFND      ; -- Not found (reject)

 +1       ;clears screen

           DO CLEAR^VALM1

 +2        SET DIR(0)="Y"

           SET DIR("B")="YES"

 +3        SET DIR("A")="Requested patient not found...Process as not found"

 +4        DO ^DIR

           KILL DIR

 +5        IF ('Y)!($DATA(DUOUT))!($DATA(DTOUT))

               SET VALMBCK="Q"

               QUIT 

 +6       ; -- Signature

           if '$DATA(VAQSIG)

               SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)

 +7        IF VAQSIG<0

               KILL VAQSIG

               DO TRANEX

               QUIT 

 +8        if '$DATA(DFN)

               SET DFN=""

 +9        SET VAQST="NFND"

 +10       if Y

               DO EP^VAQEXT03

 +11       DO TRANEX

 +12       QUIT 

 +13      ;

EXP       ; -- Expand entry

 +1        DO SEL^VALM2

 +2        if '$DATA(VALMY)

               QUIT 

 +3        NEW ENT

           SET ENT=$ORDER(VALMY(""))

 +4        SET DFN=$PIECE(^TMP("VAQR4","VAQIDX",$JOB,ENT),"^",3)

 +5        DO EP^VAQDIS01

 +6        SET VALMBCK="R"

 +7        QUIT 

 +8       ;

TRANEX    ; -- Pauses screen

 +1        DO PAUSE^VAQUTL95

 +2        if '$DATA(VAQFLAG)

               SET VAQFLAG=""

 +3        SET VALMBCK=$SELECT(VAQFLAG=0:"R",1:"Q")

 +4        QUIT 

 +5       ;

EXIT      ; -- Note: The list processor cleans up its own variables.

 +1       ;          All other variables cleaned up here.

 +2       ;

 +3        KILL ^TMP("VAQR4",$JOB),^TMP("VAQR4","VAQIDX",$JOB)

 +4        KILL VAQST,VAQFLAG,VAQCMNT,VAQDFN,VAQECNT

 +5        KILL VALMCNT,VADM,SP50,DFN

 +6        QUIT 

 +7       ;

END       ; -- End of code

 +1        QUIT