VAQLED10.m

VAQLED10 ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93

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

INIT ; -- Intialization

 D ^VAQUTL98

 ;

 N POP,DFN

 ;

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

MAIN ; -- Main entry point

 K POP,DFN,X,Y,ND,NODE

 K BADSSN,FLE,FLD ; -- table entries

 K DIROUT,DIRUT,DTOUT,DUOUT

 K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN

 S POP=0

 ;

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

 S DIR("A")="Identify PDX: "

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

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

 S DIR("??")="^D HLPTRN1^VAQLED09"

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

 S (X,VAQIN)=Y

 ;

 ; -- Function call to get patient from transaction file (DIC)

 S VAQDFN=$$GETTRN^VAQUTL96(X)

 D:VAQDFN=-1 PTNFND ; -- patient not in transaction file

 G:POP MLOOP

 D:VAQDFN>0 HEADER ; --   builds variables for header

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

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

 ;

PTNFND ; -- Requested PDX not found

 W !,"Patient not found in PDX transaction file..."

 S POP=1

 QUIT

 ;

HEADER ; -- Extracts elements for header

 ;W !,"VAQDFN = ",VAQDFN

 F ND=0,"QRY" S NODE(ND)=$G(^VAT(394.61,+VAQDFN,ND))

 S VAQPTNM=$P(NODE("QRY"),U,1),VAQISSN=$P(NODE("QRY"),U,2)

 S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)

 S VAQIDOB=$P(NODE("QRY"),U,3),VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)

 S VAQPTID=$P(NODE("QRY"),U,4)

 QUIT

 ;

EXIT ; -- Cleanup and exit routine

 K POP,DFN,X,Y,ND,NODE

 K BADSSN,FLE,FLD ; -- table entries

 K DIROUT,DIRUT,DTOUT,DUOUT

 K VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN

 QUIT

 ;

END ; -- End of code

 QUIT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VAQLED10   1762     printed  Feb 18, 2025@23:52:08                                                                                                                                                                                                    Page 2

VAQLED10  ;ALB/JFP - LOAD/EDIT PDX RECORD, PROMPT PDX;01APR93

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

INIT      ; -- Intialization

 +1        DO ^VAQUTL98

 +2       ;

 +3        NEW POP,DFN

 +4       ;

 +5       ; -- should be set from menu option

           if '$DATA(VAQOPT)

               SET VAQOPT=""

MAIN      ; -- Main entry point

 +1        KILL POP,DFN,X,Y,ND,NODE

 +2       ; -- table entries

           KILL BADSSN,FLE,FLD

 +3        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +4        KILL VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQESSN

 +5        SET POP=0

 +6       ;

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

 +8        SET DIR("A")="Identify PDX: "

 +9        SET DIR(0)="FAO^1:30^K:(X'=$C(32)&($L(X)<3)) X"

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

 +11       SET DIR("??")="^D HLPTRN1^VAQLED09"

 +12       WRITE !!

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO EXIT

 +13       SET (X,VAQIN)=Y

 +14      ;

 +15      ; -- Function call to get patient from transaction file (DIC)

 +16       SET VAQDFN=$$GETTRN^VAQUTL96(X)

 +17      ; -- patient not in transaction file

           if VAQDFN=-1

               DO PTNFND

 +18       if POP

               GOTO MLOOP

 +19      ; --   builds variables for header

           if VAQDFN>0

               DO HEADER

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

           DO EP^VAQLED01

MLOOP     ; -- loop back until no more patient added

           GOTO MAIN

 +1       ;

PTNFND    ; -- Requested PDX not found

 +1        WRITE !,"Patient not found in PDX transaction file..."

 +2        SET POP=1

 +3        QUIT 

 +4       ;

HEADER    ; -- Extracts elements for header

 +1       ;W !,"VAQDFN = ",VAQDFN

 +2        FOR ND=0,"QRY"

               SET NODE(ND)=$GET(^VAT(394.61,+VAQDFN,ND))

 +3        SET VAQPTNM=$PIECE(NODE("QRY"),U,1)

           SET VAQISSN=$PIECE(NODE("QRY"),U,2)

 +4        SET VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)

 +5        SET VAQIDOB=$PIECE(NODE("QRY"),U,3)

           SET VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)

 +6        SET VAQPTID=$PIECE(NODE("QRY"),U,4)

 +7        QUIT 

 +8       ;

EXIT      ; -- Cleanup and exit routine

 +1        KILL POP,DFN,X,Y,ND,NODE

 +2       ; -- table entries

           KILL BADSSN,FLE,FLD

 +3        KILL DIROUT,DIRUT,DTOUT,DUOUT

 +4        KILL VAQIN,VAQDFN,VAQPTNM,VAQISSN,VAQIDOB,VAQEDOB,VAQPTID,VAQOPT,VAQESSN

 +5        QUIT 

 +6       ;

END       ; -- End of code

 +1        QUIT