VAQREQ10.m

VAQREQ10 ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93

 ;;1.5;PATIENT DATA EXCHANGE;**25**;NOV 17, 1993

 ; -- Entry Points

REQ D KILL^XUSCLEAN S VAQOPT="REQ" G INIT

UNS D KILL^XUSCLEAN S VAQOPT="UNS" G INIT

 QUIT

INIT ; -- Intialization

 D ^VAQUTL98

 N POP,TASK,DFN

 S:'$D(VAQOPT) VAQOPT="" ; -- should be set from entry point

 ;

MAIN ; -- Main entry point

 K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG

 K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT

 K VAQTRN,VAQDZN,VAQPR,DFN

 S POP=0

 ;

 ; -- Call to Dir to request patient from patient file (2)

 S DIR("A")="Select Patient Name: "

 S DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"

 S DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"

 W !! D ^DIR K DIR G:$D(DIRUT) EXIT

 S VAQIN=$$UP^XLFSTR(Y)

 ;

 ; -- Function call to get patient DFN (DIC)

 S TASK=$D(ZTSK) ; -- task = 1 (batch), task = 0 interactive

 D:$D(XRTL) T0^%ZOSV ; -- Capacity start

 S VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)

 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop

 D:VAQDFN=-1 MANUAL ; -- not in patient file (manual request)

 G:POP MLOOP

 D:VAQDFN>0 VADPT ; -- pulls off MAS data

 D EP^VAQREQ01 ; -- Call to list processor (status screen)

MLOOP G MAIN ; -- loop back until no more patient added

 ;

EXIT ; -- Cleanup and exit routine

 K POP,TASK,DFN

 K DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN

 K VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG

 K VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT

 K VAQTRN,VAQDZN,VAQPR

 QUIT

 ;

MANUAL ; -- Gets Patient name SSN AND DOB if patient not found local PT file

 ; -- Don't allow manual entry of unsolicited request

 I VAQOPT="UNS" W !!,"An unsolicited PDX request requires an entry from the patient file...",!,"Press any key to continue: " S POP=1 R X:DTIME QUIT

 ;

 ; -- Request data

 S VAQEELG="Not Available"

 W !,$C(7)

 S DIR(0)="Y"

 S DIR("A")=VAQIN_" not found in local patient file...  Request PDX"

 S DIR("B")="YES"

 S DIR("?")="You will be required to enter the needed information."

 S DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."

 D ^DIR K DIR I $D(DIRUT)!('Y) S POP=1 QUIT

 ;

 ; -- Request patient name

 S DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"

 S DIR("A")="   Patient name : "

 S DIR("B")=VAQIN

 S DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"

 S DIR("??")="^D PAT^VAQREQ09"

 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT

 S VAQNM=$$UP^XLFSTR(Y)

 ;

 ; -- Request pt SSN

 S DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"

 S DIR("A")="   SSN : "

 S DIR("?")="Enter patient's SSN (without dashes)"

 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT

 S VAQISSN=Y,VAQESSN=$$DASHSSN^VAQUTL99(Y)

 ;

 ; -- Checks for name or ssn required

 I (VAQNM="")&(VAQISSN="") W !!,"Patient name or SSN is required...Press any key to continue: " S POP=1 R X:DTIME QUIT

 ;

 ; -- Request pt DOB

 S DIR(0)="DAO^::EP"

 S DIR("A")="   DATE OF BIRTH : "

 S DIR("?")="Enter patient's date of birth"

 D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S POP=1 QUIT

 S VAQIDOB=Y,VAQEDOB=$$DOBFMT^VAQUTL99(Y)

 QUIT

 ;

VADPT ; -- Pulls off patient demographics, for DFN

 ; -- Gets name,ssn,dob

 S DFN=$P(VAQDFN,U,1)

 D DEM^VADPT,ELIG^VADPT

 S VAQNM=VADM(1)

 S VAQISSN=$P(VADM(2),U,1),VAQESSN=$P(VADM(2),U,2)

 S VAQIDOB=$P(VADM(3),U,1),VAQEDOB=$P(VADM(3),U,2)

 S VAQIELG=$P(VAEL(6),U,1),VAQEELG=$P(VAEL(6),U,2)

 K VADM,VAEL,VAERR,VA

 QUIT

 ;

END ; -- End of code

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQREQ10   3625     printed  Apr 23, 2025@18:40:51                                                                                                                                                                                                    Page 2

VAQREQ10  ;ALB/JFP - REQUEST PDX RECORD, PROMPT PATIENT;01MAR93

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

 +2       ; -- Entry Points

REQ        DO KILL^XUSCLEAN

           SET VAQOPT="REQ"

           GOTO INIT

UNS        DO KILL^XUSCLEAN

           SET VAQOPT="UNS"

           GOTO INIT

 +1        QUIT 

INIT      ; -- Intialization

 +1        DO ^VAQUTL98

 +2        NEW POP,TASK,DFN

 +3       ; -- should be set from entry point

           if '$DATA(VAQOPT)

               SET VAQOPT=""

 +4       ;

MAIN      ; -- Main entry point

 +1        KILL VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG

 +2        KILL VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQRQADD,VAQRQDT,VAQRQSIT

 +3        KILL VAQTRN,VAQDZN,VAQPR,DFN

 +4        SET POP=0

 +5       ;

 +6       ; -- Call to Dir to request patient from patient file (2)

 +7        SET DIR("A")="Select Patient Name: "

 +8        SET DIR(0)="FAO^1:30^S X=$$UP^XLFSTR(X) K:(X'=$C(32)&($L(X)<1)) X"

 +9        SET DIR("?")="Enter Patient's Name (Last,First Middle) or SSN"

 +10       WRITE !!

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO EXIT

 +11       SET VAQIN=$$UP^XLFSTR(Y)

 +12      ;

 +13      ; -- Function call to get patient DFN (DIC)

 +14      ; -- task = 1 (batch), task = 0 interactive

           SET TASK=$DATA(ZTSK)

 +15      ; -- Capacity start

           if $DATA(XRTL)

               DO T0^%ZOSV

 +16       SET VAQDFN=$$GETDFN^VAQUTL97(VAQIN,TASK)

 +17      ; -- Capacity stop

           if $DATA(XRT0)

               SET XRTN=$TEXT(+0)

           if $DATA(XRT0)

               DO T1^%ZOSV

 +18      ; -- not in patient file (manual request)

           if VAQDFN=-1

               DO MANUAL

 +19       if POP

               GOTO MLOOP

 +20      ; -- pulls off MAS data

           if VAQDFN>0

               DO VADPT

 +21      ; -- Call to list processor (status screen)

           DO EP^VAQREQ01

MLOOP     ; -- loop back until no more patient added

           GOTO MAIN

 +1       ;

EXIT      ; -- Cleanup and exit routine

 +1        KILL POP,TASK,DFN

 +2        KILL DIROUT,DIRUT,DTOUT,DUOUT,X,Y,BADSSN

 +3        KILL VAQDFN,VAQIN,VAQNM,VAQISSN,VAQESSN,VAQIDOB,VAQEDOB,VAQIELG,VAQEELG

 +4        KILL VAQAUSIT,VAQDOM,VAQDZ,VAQNOTI,VAQPID,VAQOPT,VAQRQADD,VAQRQDT,VAQRQSIT

 +5        KILL VAQTRN,VAQDZN,VAQPR

 +6        QUIT 

 +7       ;

MANUAL    ; -- Gets Patient name SSN AND DOB if patient not found local PT file

 +1       ; -- Don't allow manual entry of unsolicited request

 +2        IF VAQOPT="UNS"

               WRITE !!,"An unsolicited PDX request requires an entry from the patient file...",!,"Press any key to continue: "

               SET POP=1

               READ X:DTIME

               QUIT 

 +3       ;

 +4       ; -- Request data

 +5        SET VAQEELG="Not Available"

 +6        WRITE !,$CHAR(7)

 +7        SET DIR(0)="Y"

 +8        SET DIR("A")=VAQIN_" not found in local patient file...  Request PDX"

 +9        SET DIR("B")="YES"

 +10       SET DIR("?")="You will be required to enter the needed information."

 +11       SET DIR("?",1)="Enter 'YES' to request a PDX for a patient not in your Patient File."

 +12       DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!('Y)

               SET POP=1

               QUIT 

 +13      ;

 +14      ; -- Request patient name

 +15       SET DIR(0)="FAO^3:30^S X=$$UP^XLFSTR(X) K:(X?1P.E)!(X'?1U.ANP)!(X'["","") X"

 +16       SET DIR("A")="   Patient name : "

 +17       SET DIR("B")=VAQIN

 +18       SET DIR("?")="Enter patient's name in uppercase (LAST,FIRST MIDDLE)"

 +19       SET DIR("??")="^D PAT^VAQREQ09"

 +20       DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               SET POP=1

               QUIT 

 +21       SET VAQNM=$$UP^XLFSTR(Y)

 +22      ;

 +23      ; -- Request pt SSN

 +24       SET DIR(0)="FAO^9:10^K:(X'?9N)&(X'?9N1""P"")!($D(BADSSN(X))) X"

 +25       SET DIR("A")="   SSN : "

 +26       SET DIR("?")="Enter patient's SSN (without dashes)"

 +27       DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               SET POP=1

               QUIT 

 +28       SET VAQISSN=Y

           SET VAQESSN=$$DASHSSN^VAQUTL99(Y)

 +29      ;

 +30      ; -- Checks for name or ssn required

 +31       IF (VAQNM="")&(VAQISSN="")

               WRITE !!,"Patient name or SSN is required...Press any key to continue: "

               SET POP=1

               READ X:DTIME

               QUIT 

 +32      ;

 +33      ; -- Request pt DOB

 +34       SET DIR(0)="DAO^::EP"

 +35       SET DIR("A")="   DATE OF BIRTH : "

 +36       SET DIR("?")="Enter patient's date of birth"

 +37       DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               SET POP=1

               QUIT 

 +38       SET VAQIDOB=Y

           SET VAQEDOB=$$DOBFMT^VAQUTL99(Y)

 +39       QUIT 

 +40      ;

VADPT     ; -- Pulls off patient demographics, for DFN

 +1       ; -- Gets name,ssn,dob

 +2        SET DFN=$PIECE(VAQDFN,U,1)

 +3        DO DEM^VADPT

           DO ELIG^VADPT

 +4        SET VAQNM=VADM(1)

 +5        SET VAQISSN=$PIECE(VADM(2),U,1)

           SET VAQESSN=$PIECE(VADM(2),U,2)

 +6        SET VAQIDOB=$PIECE(VADM(3),U,1)

           SET VAQEDOB=$PIECE(VADM(3),U,2)

 +7        SET VAQIELG=$PIECE(VAEL(6),U,1)

           SET VAQEELG=$PIECE(VAEL(6),U,2)

 +8        KILL VADM,VAEL,VAERR,VA

 +9        QUIT 

 +10      ;

END       ; -- End of code

 +1        QUIT