[613] | 1 | VAQLED01 ;ALB/JFP,JRP - PDX LOAD/EDIT, STATUS SCREEN;01MAR93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
|
---|
| 3 | EP ; -- Main entry point for the list processor
|
---|
| 4 | K XQORS,VALMEVL
|
---|
| 5 | D EN^VALM("VAQ LED STATUS PDX5") ; -- Protocol = VAQ PDX5 (MENU)
|
---|
| 6 | Q
|
---|
| 7 | ;
|
---|
| 8 | INIT ; -- Build array of PDX transactions for entered patient
|
---|
| 9 | K SFLAG,STATPTR,X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SDI
|
---|
| 10 | K VALMY,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT,VAQTRNO,VAQDFN
|
---|
| 11 | K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
|
---|
| 12 | D STATPTR^VAQUTL95 ; -- Set status pointers
|
---|
| 13 | S TRDE="",(VAQECNT,VALMCNT)=0
|
---|
| 14 | I (VAQISSN="")&(VAQPTNM="") D Q
|
---|
| 15 | .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
|
---|
| 16 | .S X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80) D TMP
|
---|
| 17 | D:$D(XRTL) T0^%ZOSV ; -- Capacity start
|
---|
| 18 | F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQPTNM),TRDE)) Q:TRDE="" D SETD
|
---|
| 19 | I VAQECNT=0 D
|
---|
| 20 | .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
|
---|
| 21 | .S X=$$SETSTR^VALM1(" ** PDX results not found for patient entered... ","",1,80) D TMP
|
---|
| 22 | S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | SETD ; -- Set data for display in list processor
|
---|
| 26 | N NAME,SSN,TMP
|
---|
| 27 | S SFLAG=0
|
---|
| 28 | S STATPTR=$P($G(^VAT(394.61,TRDE,0)),U,2)
|
---|
| 29 | S:VAQRSLT=STATPTR SFLAG=SFLAG+1
|
---|
| 30 | S:VAQUNSOL=STATPTR SFLAG=SFLAG+1
|
---|
| 31 | Q:SFLAG=0
|
---|
| 32 | ; -- Filter out transactions marked as purged OR excede life cap
|
---|
| 33 | S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set from SETD+2
|
---|
| 34 | Q:VAQFLAG=1
|
---|
| 35 | ;
|
---|
| 36 | F ND=0,"QRY","RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
|
---|
| 37 | S TRNO=+NODE(0)
|
---|
| 38 | S VAQTDTE=$S(((STATPTR=VAQRSLT)!(STATPTR=VAQUNSOL)):+NODE("ATHR1"),1:+NODE("RQST1"))
|
---|
| 39 | S DATETIME=$$DOBFMT^VAQUTL99(VAQTDTE,0)
|
---|
| 40 | S TMP=$P(VAQTDTE,".",2)_"000000"
|
---|
| 41 | S DATETIME=DATETIME_"@"_$E(TMP,1,2)_":"_$E(TMP,3,4)_":"_$E(TMP,5,6)
|
---|
| 42 | S DATETIME=DATETIME_$S((STATPTR=VAQRSLT):" (Rs)",(STATPTR=VAQUNSOL):" (Uns)",1:" (Req)")
|
---|
| 43 | ;
|
---|
| 44 | S DOMAIN=$P(NODE("ATHR2"),U,2)
|
---|
| 45 | S VAQECNT=VAQECNT+1
|
---|
| 46 | S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
|
---|
| 47 | S X=$$SETFLD^VALM1(DOMAIN,X,"DOMAIN")
|
---|
| 48 | S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
|
---|
| 49 | S X=$$SETFLD^VALM1(TRNO,X,"TRNO")
|
---|
| 50 | D TMP
|
---|
| 51 | ;GET REQUESTED PATIENT INFO
|
---|
| 52 | S NAME=$P(NODE("QRY"),"^",1)
|
---|
| 53 | S SSN=$$DASHSSN^VAQUTL99($P(NODE("QRY"),"^",2))
|
---|
| 54 | S TMP=NAME_" ("_SSN_")"
|
---|
| 55 | S:(STATPTR=VAQUNSOL) TMP="Not Applicable"
|
---|
| 56 | S X=" Requested Patient: "_TMP
|
---|
| 57 | D TMP
|
---|
| 58 | ;GET RELEASED PATIENT INFO
|
---|
| 59 | S TMP=$$RLSEPAT^VAQUTL92(TRDE)
|
---|
| 60 | S NAME=$P(TMP,"^",1)
|
---|
| 61 | S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
|
---|
| 62 | S TMP=NAME_" ("_SSN_")"
|
---|
| 63 | S:((STATPTR'=VAQUNSOL)&(STATPTR'=VAQRSLT)) TMP="Not Applicable"
|
---|
| 64 | S X=" Released Patient: "_TMP
|
---|
| 65 | D TMP
|
---|
| 66 | ;BLANK LINE
|
---|
| 67 | S X=" " D TMP
|
---|
| 68 | Q
|
---|
| 69 | ;
|
---|
| 70 | TMP ; -- Set the array used by list processor
|
---|
| 71 | S VALMCNT=VALMCNT+1
|
---|
| 72 | S ^TMP("VAQL1",$J,VALMCNT,0)=$E(X,1,79)
|
---|
| 73 | S ^TMP("VAQL1",$J,"IDX",VALMCNT,VAQECNT)=""
|
---|
| 74 | S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | HD ; -- Make header line for list processor
|
---|
| 78 | N TMP
|
---|
| 79 | S VALMHDR(1)=" "
|
---|
| 80 | S TMP="PDX Transactions referencing "_VAQPTNM_" ("_VAQESSN_")"
|
---|
| 81 | S VALMHDR(2)=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
|
---|
| 82 | S VALMHDR(3)=" "
|
---|
| 83 | Q
|
---|
| 84 | ;
|
---|
| 85 | LED ; -- load/edit
|
---|
| 86 | S ^TMP("VAQL1",$J)=VAQPTNM_"^"_VAQISSN
|
---|
| 87 | S VAQBCK=0
|
---|
| 88 | D EN^VALM2($G(XQORNOD(0)),"S")
|
---|
| 89 | Q:'$D(VALMY)
|
---|
| 90 | D CLEAR^VALM1
|
---|
| 91 | D SIGNA ; -- Signature
|
---|
| 92 | I VAQSIG<0 K VAQSIG D PAUSE^VAQUTL95 S VALMBCK="R" Q
|
---|
| 93 | S SDI=+$O(VALMY(0)) Q:'SDI
|
---|
| 94 | S SDAT=$G(^TMP("VAQIDX",$J,SDI))
|
---|
| 95 | S VAQTRNO=$P(SDAT,U,2),DFN=""
|
---|
| 96 | S DFNTR=+$O(^VAT(394.61,"B",VAQTRNO,0))
|
---|
| 97 | S VAQPTID=$$RLSEPAT^VAQUTL92(DFNTR)
|
---|
| 98 | S VAQPTNM=$P(VAQPTID,"^",1)
|
---|
| 99 | S VAQISSN=$P(VAQPTID,"^",2)
|
---|
| 100 | S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
|
---|
| 101 | S VAQIDOB=$P(VAQPTID,"^",3)
|
---|
| 102 | S VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
|
---|
| 103 | S VAQPTID=""
|
---|
| 104 | D EP^VAQLED03 ; -- Finds local matches in database
|
---|
| 105 | S SDI=^TMP("VAQL1",$J)
|
---|
| 106 | I VAQBCK=1 K VALMBCK Q
|
---|
| 107 | S VAQPTNM=$P(SDI,"^",1),VAQISSN=$P(SDI,"^",2)
|
---|
| 108 | D INIT
|
---|
| 109 | S VALMBCK="R"
|
---|
| 110 | Q
|
---|
| 111 | ;
|
---|
| 112 | EXPAND ; -- Displays MAS minimal information from PDX data file (394.62)
|
---|
| 113 | D EN^VALM2($G(XQORNOD(0)),"S")
|
---|
| 114 | Q:'$D(VALMY)
|
---|
| 115 | S SDI=""
|
---|
| 116 | F S SDI=$O(VALMY(SDI)) Q:SDI="" D
|
---|
| 117 | .S SDAT=$G(^TMP("VAQIDX",$J,SDI))
|
---|
| 118 | .S VAQTRNO=$P(SDAT,U,2),DFN=""
|
---|
| 119 | .S DFN=$O(^VAT(394.61,"B",VAQTRNO,DFN))
|
---|
| 120 | .D TR^VAQDIS01 ; -- expands entry from 394.62 (data file)
|
---|
| 121 | S VALMBCK="R"
|
---|
| 122 | Q
|
---|
| 123 | ;
|
---|
| 124 | CREATE ; -- Creates new patient
|
---|
| 125 | D EP^VAQLED07 Q
|
---|
| 126 | ;
|
---|
| 127 | SIGNA ; -- Signature
|
---|
| 128 | S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) Q
|
---|
| 129 | ;
|
---|
| 130 | EXIT ; -- Note: The list processor cleans up its own variables.
|
---|
| 131 | ; All other variables cleaned up here.
|
---|
| 132 | K X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SFLAG,STATPTR
|
---|
| 133 | K VALMY,SDI,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT
|
---|
| 134 | K VAQSIG,VAQTRNO,VAQDFN,VAQPTNM,VAQIDOB,VAQEDOB,VAQISSN,VAQPTID
|
---|
| 135 | K VAQCDTE,VAQTDTE,VAQFLAG,VAQBCK
|
---|
| 136 | K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
|
---|
| 137 | K VAQADFL ; -- set in VAQDIS01
|
---|
| 138 | Q
|
---|