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 Dec 13, 2024@02:25:58 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
