[613] | 1 | VAQDIS12 ;ALB/JFP - PDX,SELECTION SCREEN FOR DISPLAY BY REQUESTOR;01MAR93
|
---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
|
---|
| 3 | EP ; -- Main entry point for the list processor
|
---|
| 4 | I '($D(DUZ)) W !,"Duz required for this option" D PAUSE^VALM1 QUIT
|
---|
| 5 | ;
|
---|
| 6 | N VAQDZN,VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
|
---|
| 7 | S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
|
---|
| 8 | K XQORS,VALMEVL
|
---|
| 9 | D EN^VALM("VAQ DIS REQUESTOR PDX10") ; -- Protocol = VAQ PDX9 (MENU)
|
---|
| 10 | QUIT
|
---|
| 11 | ;
|
---|
| 12 | INIT ; -- Builds array of PDX transactions by requestor
|
---|
| 13 | K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
|
---|
| 14 | ;
|
---|
| 15 | D STATPTR^VAQUTL95 ; -- Sets PDX status pointers (vaq-rslt,vaq-unsol)
|
---|
| 16 | ;
|
---|
| 17 | D:$D(XRTL) T0^%ZOSV ; -- Capacity start
|
---|
| 18 | S TRDE="",(VAQECNT,VALMCNT)=0
|
---|
| 19 | F S TRDE=$O(^VAT(394.61,"AC",VAQDZN,TRDE)) Q:TRDE="" D SETD
|
---|
| 20 | I VAQECNT=0 D
|
---|
| 21 | .S VAQTRN=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
|
---|
| 22 | .S X=$$SETSTR^VALM1(" ** PDX results not found for this requestor... ","",1,80) D TMP
|
---|
| 23 | S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
|
---|
| 24 | QUIT
|
---|
| 25 | ;
|
---|
| 26 | SETD ; -- Set data for display in list processor
|
---|
| 27 | S VAQCSTAT=$P($G(^VAT(394.61,TRDE,0)),U,2)
|
---|
| 28 | ; -- Filter out transaction without results
|
---|
| 29 | I ((VAQCSTAT)'=VAQRSLT)&((VAQCSTAT)'=VAQUNSOL) QUIT
|
---|
| 30 | ; -- Filter out transactions marked as purged OR excides life cap
|
---|
| 31 | S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
|
---|
| 32 | Q:VAQFLAG=1
|
---|
| 33 | ;
|
---|
| 34 | S X0=$$TRNDATA^VAQUTL92(TRDE) ; -- Extracts data from transaction file
|
---|
| 35 | S STATUS=$S(VAQCSTAT'="":$P($G(^VAT(394.85,VAQCSTAT,0)),U,2),1:" ")
|
---|
| 36 | S:VAQADT'="" DATETIME=VAQADT_" (Rs)"
|
---|
| 37 | S:VAQADT="" DATETIME=VAQRDT_" (Rq)"
|
---|
| 38 | S VAQECNT=VAQECNT+1
|
---|
| 39 | S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
|
---|
| 40 | S X=$$SETFLD^VALM1(VAQADOM,X,"DOMAIN")
|
---|
| 41 | S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
|
---|
| 42 | S X=$$SETFLD^VALM1(VAQTRN,X,"TRNO")
|
---|
| 43 | D TMP
|
---|
| 44 | S X=$$SETSTR^VALM1(VAQPTNM,"",7,80) D TMP
|
---|
| 45 | S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
|
---|
| 46 | D KILLTRN^VAQUTL92 ; -- Cleans up variables set in TRNDATA
|
---|
| 47 | QUIT
|
---|
| 48 | ;
|
---|
| 49 | HD ; -- Make header line for list processor
|
---|
| 50 | S X=$$SETSTR^VALM1("Requestor: "_VAQDZN,"",1,79)
|
---|
| 51 | S VALMHDR(1)=" ",VALMHDR(2)=X,VALMHDR(3)=" "
|
---|
| 52 | QUIT
|
---|
| 53 | ;
|
---|
| 54 | SEL ; -- Selects patient to display, checks sensative patient
|
---|
| 55 | N VALMY,SDI,SDAT
|
---|
| 56 | S:'$D(VAQBCK) VAQBCK=0
|
---|
| 57 | D EN^VALM2($G(XQORNOD(0)),"S")
|
---|
| 58 | Q:'$D(VALMY)
|
---|
| 59 | S SDI=""
|
---|
| 60 | S SDI=$O(VALMY(SDI)) Q:SDI=""
|
---|
| 61 | S SDAT=$G(^TMP("VAQIDX",$J,SDI))
|
---|
| 62 | S VAQTRN=$P(SDAT,U,2),DFN=""
|
---|
| 63 | S (VAQDFN,DFN)=$O(^VAT(394.61,"B",VAQTRN,DFN))
|
---|
| 64 | I $P($G(^VAT(394.61,DFN,0)),U,4)=1 D WORKLD^VAQDIS11
|
---|
| 65 | D EP^VAQDIS15 ; -- Display segments
|
---|
| 66 | I VAQBCK=1 K VALMBCK QUIT
|
---|
| 67 | D INIT
|
---|
| 68 | S VALMBCK="R"
|
---|
| 69 | QUIT
|
---|
| 70 | ;
|
---|
| 71 | TMP ; -- Set the array used by list processor
|
---|
| 72 | S VALMCNT=VALMCNT+1
|
---|
| 73 | S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
|
---|
| 74 | S ^TMP("VAQD1",$J,"IDX",VALMCNT,VAQECNT)=""
|
---|
| 75 | S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRN
|
---|
| 76 | QUIT
|
---|
| 77 | ;
|
---|
| 78 | EXIT ; -- Note: The list processor cleans up its own variables.
|
---|
| 79 | ; All other variables cleaned up here.
|
---|
| 80 | ;
|
---|
| 81 | K VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
|
---|
| 82 | K POP,VAQBCK,VAQDFN,DFN,ENTRY
|
---|
| 83 | K DATETIME,VAQCSTAT
|
---|
| 84 | K VAQADFL ; -- set in VAQDIS01 (display min)
|
---|
| 85 | K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
|
---|
| 86 | QUIT
|
---|
| 87 | ;
|
---|
| 88 | END ; -- End of code
|
---|
| 89 | QUIT
|
---|