- VAQLED01 ;ALB/JFP,JRP - PDX LOAD/EDIT, STATUS SCREEN;01MAR93
- ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
- EP ; -- Main entry point for the list processor
- K XQORS,VALMEVL
- D EN^VALM("VAQ LED STATUS PDX5") ; -- Protocol = VAQ PDX5 (MENU)
- Q
- ;
- INIT ; -- Build array of PDX transactions for entered patient
- K SFLAG,STATPTR,X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SDI
- K VALMY,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT,VAQTRNO,VAQDFN
- K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
- D STATPTR^VAQUTL95 ; -- Set status pointers
- S TRDE="",(VAQECNT,VALMCNT)=0
- I (VAQISSN="")&(VAQPTNM="") D Q
- .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
- .S X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80) D TMP
- D:$D(XRTL) T0^%ZOSV ; -- Capacity start
- F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQPTNM),TRDE)) Q:TRDE="" D SETD
- I VAQECNT=0 D
- .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
- .S X=$$SETSTR^VALM1(" ** PDX results not found for patient entered... ","",1,80) D TMP
- S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
- Q
- ;
- SETD ; -- Set data for display in list processor
- N NAME,SSN,TMP
- S SFLAG=0
- S STATPTR=$P($G(^VAT(394.61,TRDE,0)),U,2)
- S:VAQRSLT=STATPTR SFLAG=SFLAG+1
- S:VAQUNSOL=STATPTR SFLAG=SFLAG+1
- Q:SFLAG=0
- ; -- Filter out transactions marked as purged OR excede life cap
- S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set from SETD+2
- Q:VAQFLAG=1
- ;
- F ND=0,"QRY","RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
- S TRNO=+NODE(0)
- S VAQTDTE=$S(((STATPTR=VAQRSLT)!(STATPTR=VAQUNSOL)):+NODE("ATHR1"),1:+NODE("RQST1"))
- S DATETIME=$$DOBFMT^VAQUTL99(VAQTDTE,0)
- S TMP=$P(VAQTDTE,".",2)_"000000"
- S DATETIME=DATETIME_"@"_$E(TMP,1,2)_":"_$E(TMP,3,4)_":"_$E(TMP,5,6)
- S DATETIME=DATETIME_$S((STATPTR=VAQRSLT):" (Rs)",(STATPTR=VAQUNSOL):" (Uns)",1:" (Req)")
- ;
- S DOMAIN=$P(NODE("ATHR2"),U,2)
- S VAQECNT=VAQECNT+1
- S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
- S X=$$SETFLD^VALM1(DOMAIN,X,"DOMAIN")
- S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
- S X=$$SETFLD^VALM1(TRNO,X,"TRNO")
- D TMP
- ;GET REQUESTED PATIENT INFO
- S NAME=$P(NODE("QRY"),"^",1)
- S SSN=$$DASHSSN^VAQUTL99($P(NODE("QRY"),"^",2))
- S TMP=NAME_" ("_SSN_")"
- S:(STATPTR=VAQUNSOL) TMP="Not Applicable"
- S X=" Requested Patient: "_TMP
- D TMP
- ;GET RELEASED PATIENT INFO
- S TMP=$$RLSEPAT^VAQUTL92(TRDE)
- S NAME=$P(TMP,"^",1)
- S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
- S TMP=NAME_" ("_SSN_")"
- S:((STATPTR'=VAQUNSOL)&(STATPTR'=VAQRSLT)) TMP="Not Applicable"
- S X=" Released Patient: "_TMP
- D TMP
- ;BLANK LINE
- S X=" " D TMP
- Q
- ;
- TMP ; -- Set the array used by list processor
- S VALMCNT=VALMCNT+1
- S ^TMP("VAQL1",$J,VALMCNT,0)=$E(X,1,79)
- S ^TMP("VAQL1",$J,"IDX",VALMCNT,VAQECNT)=""
- S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
- Q
- ;
- HD ; -- Make header line for list processor
- N TMP
- S VALMHDR(1)=" "
- S TMP="PDX Transactions referencing "_VAQPTNM_" ("_VAQESSN_")"
- S VALMHDR(2)=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
- S VALMHDR(3)=" "
- Q
- ;
- LED ; -- load/edit
- S ^TMP("VAQL1",$J)=VAQPTNM_"^"_VAQISSN
- S VAQBCK=0
- D EN^VALM2($G(XQORNOD(0)),"S")
- Q:'$D(VALMY)
- D CLEAR^VALM1
- D SIGNA ; -- Signature
- I VAQSIG<0 K VAQSIG D PAUSE^VAQUTL95 S VALMBCK="R" Q
- S SDI=+$O(VALMY(0)) Q:'SDI
- S SDAT=$G(^TMP("VAQIDX",$J,SDI))
- S VAQTRNO=$P(SDAT,U,2),DFN=""
- S DFNTR=+$O(^VAT(394.61,"B",VAQTRNO,0))
- S VAQPTID=$$RLSEPAT^VAQUTL92(DFNTR)
- S VAQPTNM=$P(VAQPTID,"^",1)
- S VAQISSN=$P(VAQPTID,"^",2)
- S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
- S VAQIDOB=$P(VAQPTID,"^",3)
- S VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
- S VAQPTID=""
- D EP^VAQLED03 ; -- Finds local matches in database
- S SDI=^TMP("VAQL1",$J)
- I VAQBCK=1 K VALMBCK Q
- S VAQPTNM=$P(SDI,"^",1),VAQISSN=$P(SDI,"^",2)
- D INIT
- S VALMBCK="R"
- Q
- ;
- EXPAND ; -- Displays MAS minimal information from PDX data file (394.62)
- D EN^VALM2($G(XQORNOD(0)),"S")
- Q:'$D(VALMY)
- S SDI=""
- F S SDI=$O(VALMY(SDI)) Q:SDI="" D
- .S SDAT=$G(^TMP("VAQIDX",$J,SDI))
- .S VAQTRNO=$P(SDAT,U,2),DFN=""
- .S DFN=$O(^VAT(394.61,"B",VAQTRNO,DFN))
- .D TR^VAQDIS01 ; -- expands entry from 394.62 (data file)
- S VALMBCK="R"
- Q
- ;
- CREATE ; -- Creates new patient
- D EP^VAQLED07 Q
- ;
- SIGNA ; -- Signature
- S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) Q
- ;
- EXIT ; -- Note: The list processor cleans up its own variables.
- ; All other variables cleaned up here.
- K X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SFLAG,STATPTR
- K VALMY,SDI,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT
- K VAQSIG,VAQTRNO,VAQDFN,VAQPTNM,VAQIDOB,VAQEDOB,VAQISSN,VAQPTID
- K VAQCDTE,VAQTDTE,VAQFLAG,VAQBCK
- K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
- K VAQADFL ; -- set in VAQDIS01
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED01 4735 printed Feb 18, 2025@23:52:01 Page 2
- VAQLED01 ;ALB/JFP,JRP - PDX LOAD/EDIT, STATUS SCREEN;01MAR93
- +1 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
- EP ; -- Main entry point for the list processor
- +1 KILL XQORS,VALMEVL
- +2 ; -- Protocol = VAQ PDX5 (MENU)
- DO EN^VALM("VAQ LED STATUS PDX5")
- +3 QUIT
- +4 ;
- INIT ; -- Build array of PDX transactions for entered patient
- +1 KILL SFLAG,STATPTR,X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SDI
- +2 KILL VALMY,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT,VAQTRNO,VAQDFN
- +3 KILL ^TMP("VAQL1",$JOB),^TMP("VAQIDX",$JOB)
- +4 ; -- Set status pointers
- DO STATPTR^VAQUTL95
- +5 SET TRDE=""
- SET (VAQECNT,VALMCNT)=0
- +6 IF (VAQISSN="")&(VAQPTNM="")
- Begin DoDot:1
- +7 SET TRNO=0
- SET X=$$SETSTR^VALM1(" ","",1,79)
- DO TMP
- +8 SET X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80)
- DO TMP
- End DoDot:1
- QUIT
- +9 ; -- Capacity start
- if $DATA(XRTL)
- DO T0^%ZOSV
- +10 FOR
- SET TRDE=$ORDER(^VAT(394.61,$SELECT(VAQISSN'="":"SSN",1:"NAME"),$SELECT(VAQISSN'="":VAQISSN,1:VAQPTNM),TRDE))
- if TRDE=""
- QUIT
- DO SETD
- +11 IF VAQECNT=0
- Begin DoDot:1
- +12 SET TRNO=0
- SET X=$$SETSTR^VALM1(" ","",1,79)
- DO TMP
- +13 SET X=$$SETSTR^VALM1(" ** PDX results not found for patient entered... ","",1,80)
- DO TMP
- End DoDot:1
- +14 if $DATA(XRT0)
- SET XRTN=$TEXT(+0)
- if $DATA(XRT0)
- DO T1^%ZOSV
- +15 QUIT
- +16 ;
- SETD ; -- Set data for display in list processor
- +1 NEW NAME,SSN,TMP
- +2 SET SFLAG=0
- +3 SET STATPTR=$PIECE($GET(^VAT(394.61,TRDE,0)),U,2)
- +4 if VAQRSLT=STATPTR
- SET SFLAG=SFLAG+1
- +5 if VAQUNSOL=STATPTR
- SET SFLAG=SFLAG+1
- +6 if SFLAG=0
- QUIT
- +7 ; -- Filter out transactions marked as purged OR excede life cap
- +8 ; -- naked set from SETD+2
- SET VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
- +9 if VAQFLAG=1
- QUIT
- +10 ;
- +11 FOR ND=0,"QRY","RQST1","RQST2","ATHR1","ATHR2"
- SET NODE(ND)=$GET(^VAT(394.61,TRDE,ND))
- +12 SET TRNO=+NODE(0)
- +13 SET VAQTDTE=$SELECT(((STATPTR=VAQRSLT)!(STATPTR=VAQUNSOL)):+NODE("ATHR1"),1:+NODE("RQST1"))
- +14 SET DATETIME=$$DOBFMT^VAQUTL99(VAQTDTE,0)
- +15 SET TMP=$PIECE(VAQTDTE,".",2)_"000000"
- +16 SET DATETIME=DATETIME_"@"_$EXTRACT(TMP,1,2)_":"_$EXTRACT(TMP,3,4)_":"_$EXTRACT(TMP,5,6)
- +17 SET DATETIME=DATETIME_$SELECT((STATPTR=VAQRSLT):" (Rs)",(STATPTR=VAQUNSOL):" (Uns)",1:" (Req)")
- +18 ;
- +19 SET DOMAIN=$PIECE(NODE("ATHR2"),U,2)
- +20 SET VAQECNT=VAQECNT+1
- +21 SET X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
- +22 SET X=$$SETFLD^VALM1(DOMAIN,X,"DOMAIN")
- +23 SET X=$$SETFLD^VALM1(DATETIME,X,"DATE")
- +24 SET X=$$SETFLD^VALM1(TRNO,X,"TRNO")
- +25 DO TMP
- +26 ;GET REQUESTED PATIENT INFO
- +27 SET NAME=$PIECE(NODE("QRY"),"^",1)
- +28 SET SSN=$$DASHSSN^VAQUTL99($PIECE(NODE("QRY"),"^",2))
- +29 SET TMP=NAME_" ("_SSN_")"
- +30 if (STATPTR=VAQUNSOL)
- SET TMP="Not Applicable"
- +31 SET X=" Requested Patient: "_TMP
- +32 DO TMP
- +33 ;GET RELEASED PATIENT INFO
- +34 SET TMP=$$RLSEPAT^VAQUTL92(TRDE)
- +35 SET NAME=$PIECE(TMP,"^",1)
- +36 SET SSN=$$DASHSSN^VAQUTL99($PIECE(TMP,"^",2))
- +37 SET TMP=NAME_" ("_SSN_")"
- +38 if ((STATPTR'=VAQUNSOL)&(STATPTR'=VAQRSLT))
- SET TMP="Not Applicable"
- +39 SET X=" Released Patient: "_TMP
- +40 DO TMP
- +41 ;BLANK LINE
- +42 SET X=" "
- DO TMP
- +43 QUIT
- +44 ;
- TMP ; -- Set the array used by list processor
- +1 SET VALMCNT=VALMCNT+1
- +2 SET ^TMP("VAQL1",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
- +3 SET ^TMP("VAQL1",$JOB,"IDX",VALMCNT,VAQECNT)=""
- +4 SET ^TMP("VAQIDX",$JOB,VAQECNT)=VALMCNT_"^"_TRNO
- +5 QUIT
- +6 ;
- HD ; -- Make header line for list processor
- +1 NEW TMP
- +2 SET VALMHDR(1)=" "
- +3 SET TMP="PDX Transactions referencing "_VAQPTNM_" ("_VAQESSN_")"
- +4 SET VALMHDR(2)=$$INSERT^VAQUTL1(TMP,"",(40-($LENGTH(TMP)/2)))
- +5 SET VALMHDR(3)=" "
- +6 QUIT
- +7 ;
- LED ; -- load/edit
- +1 SET ^TMP("VAQL1",$JOB)=VAQPTNM_"^"_VAQISSN
- +2 SET VAQBCK=0
- +3 DO EN^VALM2($GET(XQORNOD(0)),"S")
- +4 if '$DATA(VALMY)
- QUIT
- +5 DO CLEAR^VALM1
- +6 ; -- Signature
- DO SIGNA
- +7 IF VAQSIG<0
- KILL VAQSIG
- DO PAUSE^VAQUTL95
- SET VALMBCK="R"
- QUIT
- +8 SET SDI=+$ORDER(VALMY(0))
- if 'SDI
- QUIT
- +9 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
- +10 SET VAQTRNO=$PIECE(SDAT,U,2)
- SET DFN=""
- +11 SET DFNTR=+$ORDER(^VAT(394.61,"B",VAQTRNO,0))
- +12 SET VAQPTID=$$RLSEPAT^VAQUTL92(DFNTR)
- +13 SET VAQPTNM=$PIECE(VAQPTID,"^",1)
- +14 SET VAQISSN=$PIECE(VAQPTID,"^",2)
- +15 SET VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
- +16 SET VAQIDOB=$PIECE(VAQPTID,"^",3)
- +17 SET VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
- +18 SET VAQPTID=""
- +19 ; -- Finds local matches in database
- DO EP^VAQLED03
- +20 SET SDI=^TMP("VAQL1",$JOB)
- +21 IF VAQBCK=1
- KILL VALMBCK
- QUIT
- +22 SET VAQPTNM=$PIECE(SDI,"^",1)
- SET VAQISSN=$PIECE(SDI,"^",2)
- +23 DO INIT
- +24 SET VALMBCK="R"
- +25 QUIT
- +26 ;
- EXPAND ; -- Displays MAS minimal information from PDX data file (394.62)
- +1 DO EN^VALM2($GET(XQORNOD(0)),"S")
- +2 if '$DATA(VALMY)
- QUIT
- +3 SET SDI=""
- +4 FOR
- SET SDI=$ORDER(VALMY(SDI))
- if SDI=""
- QUIT
- Begin DoDot:1
- +5 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
- +6 SET VAQTRNO=$PIECE(SDAT,U,2)
- SET DFN=""
- +7 SET DFN=$ORDER(^VAT(394.61,"B",VAQTRNO,DFN))
- +8 ; -- expands entry from 394.62 (data file)
- DO TR^VAQDIS01
- End DoDot:1
- +9 SET VALMBCK="R"
- +10 QUIT
- +11 ;
- CREATE ; -- Creates new patient
- +1 DO EP^VAQLED07
- QUIT
- +2 ;
- SIGNA ; -- Signature
- +1 if '$DATA(VAQSIG)
- SET VAQSIG=$$VRFYUSER^VAQAUT(DUZ)
- QUIT
- +2 ;
- EXIT ; -- Note: The list processor cleans up its own variables.
- +1 ; All other variables cleaned up here.
- +2 KILL X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SFLAG,STATPTR
- +3 KILL VALMY,SDI,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT
- +4 KILL VAQSIG,VAQTRNO,VAQDFN,VAQPTNM,VAQIDOB,VAQEDOB,VAQISSN,VAQPTID
- +5 KILL VAQCDTE,VAQTDTE,VAQFLAG,VAQBCK
- +6 KILL ^TMP("VAQL1",$JOB),^TMP("VAQIDX",$JOB)
- +7 ; -- set in VAQDIS01
- KILL VAQADFL
- +8 QUIT