VAQDIS12 ;ALB/JFP - PDX,SELECTION SCREEN FOR DISPLAY BY REQUESTOR;01MAR93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
I '($D(DUZ)) W !,"Duz required for this option" D PAUSE^VALM1 QUIT
;
N VAQDZN,VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
K XQORS,VALMEVL
D EN^VALM("VAQ DIS REQUESTOR PDX10") ; -- Protocol = VAQ PDX9 (MENU)
QUIT
;
INIT ; -- Builds array of PDX transactions by requestor
K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
;
D STATPTR^VAQUTL95 ; -- Sets PDX status pointers (vaq-rslt,vaq-unsol)
;
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
S TRDE="",(VAQECNT,VALMCNT)=0
F S TRDE=$O(^VAT(394.61,"AC",VAQDZN,TRDE)) Q:TRDE="" D SETD
I VAQECNT=0 D
.S VAQTRN=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
.S X=$$SETSTR^VALM1(" ** PDX results not found for this requestor... ","",1,80) D TMP
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
QUIT
;
SETD ; -- Set data for display in list processor
S VAQCSTAT=$P($G(^VAT(394.61,TRDE,0)),U,2)
; -- Filter out transaction without results
I ((VAQCSTAT)'=VAQRSLT)&((VAQCSTAT)'=VAQUNSOL) QUIT
; -- Filter out transactions marked as purged OR excides life cap
S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
Q:VAQFLAG=1
;
S X0=$$TRNDATA^VAQUTL92(TRDE) ; -- Extracts data from transaction file
S STATUS=$S(VAQCSTAT'="":$P($G(^VAT(394.85,VAQCSTAT,0)),U,2),1:" ")
S:VAQADT'="" DATETIME=VAQADT_" (Rs)"
S:VAQADT="" DATETIME=VAQRDT_" (Rq)"
S VAQECNT=VAQECNT+1
S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
S X=$$SETFLD^VALM1(VAQADOM,X,"DOMAIN")
S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
S X=$$SETFLD^VALM1(VAQTRN,X,"TRNO")
D TMP
S X=$$SETSTR^VALM1(VAQPTNM,"",7,80) D TMP
S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
D KILLTRN^VAQUTL92 ; -- Cleans up variables set in TRNDATA
QUIT
;
HD ; -- Make header line for list processor
S X=$$SETSTR^VALM1("Requestor: "_VAQDZN,"",1,79)
S VALMHDR(1)=" ",VALMHDR(2)=X,VALMHDR(3)=" "
QUIT
;
SEL ; -- Selects patient to display, checks sensative patient
N VALMY,SDI,SDAT
S:'$D(VAQBCK) VAQBCK=0
D EN^VALM2($G(XQORNOD(0)),"S")
Q:'$D(VALMY)
S SDI=""
S SDI=$O(VALMY(SDI)) Q:SDI=""
S SDAT=$G(^TMP("VAQIDX",$J,SDI))
S VAQTRN=$P(SDAT,U,2),DFN=""
S (VAQDFN,DFN)=$O(^VAT(394.61,"B",VAQTRN,DFN))
I $P($G(^VAT(394.61,DFN,0)),U,4)=1 D WORKLD^VAQDIS11
D EP^VAQDIS15 ; -- Display segments
I VAQBCK=1 K VALMBCK QUIT
D INIT
S VALMBCK="R"
QUIT
;
TMP ; -- Set the array used by list processor
S VALMCNT=VALMCNT+1
S ^TMP("VAQD1",$J,VALMCNT,0)=$E(X,1,79)
S ^TMP("VAQD1",$J,"IDX",VALMCNT,VAQECNT)=""
S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_VAQTRN
QUIT
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
;
K VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
K POP,VAQBCK,VAQDFN,DFN,ENTRY
K DATETIME,VAQCSTAT
K VAQADFL ; -- set in VAQDIS01 (display min)
K ^TMP("VAQD1",$J),^TMP("VAQIDX",$J)
QUIT
;
END ; -- End of code
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS12 3086 printed Dec 13, 2024@02:25:19 Page 2
VAQDIS12 ;ALB/JFP - PDX,SELECTION SCREEN FOR DISPLAY BY REQUESTOR;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 IF '($DATA(DUZ))
WRITE !,"Duz required for this option"
DO PAUSE^VALM1
QUIT
+2 ;
+3 NEW VAQDZN,VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
+4 SET VAQDZN=$SELECT($DATA(DUZ):$PIECE(^VA(200,DUZ,0),U,1),1:"")
+5 KILL XQORS,VALMEVL
+6 ; -- Protocol = VAQ PDX9 (MENU)
DO EN^VALM("VAQ DIS REQUESTOR PDX10")
+7 QUIT
+8 ;
INIT ; -- Builds array of PDX transactions by requestor
+1 KILL ^TMP("VAQD1",$JOB),^TMP("VAQIDX",$JOB)
+2 ;
+3 ; -- Sets PDX status pointers (vaq-rslt,vaq-unsol)
DO STATPTR^VAQUTL95
+4 ;
+5 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+6 SET TRDE=""
SET (VAQECNT,VALMCNT)=0
+7 FOR
SET TRDE=$ORDER(^VAT(394.61,"AC",VAQDZN,TRDE))
if TRDE=""
QUIT
DO SETD
+8 IF VAQECNT=0
Begin DoDot:1
+9 SET VAQTRN=0
SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP
+10 SET X=$$SETSTR^VALM1(" ** PDX results not found for this requestor... ","",1,80)
DO TMP
End DoDot:1
+11 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+12 QUIT
+13 ;
SETD ; -- Set data for display in list processor
+1 SET VAQCSTAT=$PIECE($GET(^VAT(394.61,TRDE,0)),U,2)
+2 ; -- Filter out transaction without results
+3 IF ((VAQCSTAT)'=VAQRSLT)&((VAQCSTAT)'=VAQUNSOL)
QUIT
+4 ; -- Filter out transactions marked as purged OR excides life cap
+5 SET VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
+6 if VAQFLAG=1
QUIT
+7 ;
+8 ; -- Extracts data from transaction file
SET X0=$$TRNDATA^VAQUTL92(TRDE)
+9 SET STATUS=$SELECT(VAQCSTAT'="":$PIECE($GET(^VAT(394.85,VAQCSTAT,0)),U,2),1:" ")
+10 if VAQADT'=""
SET DATETIME=VAQADT_" (Rs)"
+11 if VAQADT=""
SET DATETIME=VAQRDT_" (Rq)"
+12 SET VAQECNT=VAQECNT+1
+13 SET X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
+14 SET X=$$SETFLD^VALM1(VAQADOM,X,"DOMAIN")
+15 SET X=$$SETFLD^VALM1(DATETIME,X,"DATE")
+16 SET X=$$SETFLD^VALM1(VAQTRN,X,"TRNO")
+17 DO TMP
+18 SET X=$$SETSTR^VALM1(VAQPTNM,"",7,80)
DO TMP
+19 ; -- null line
SET X=$$SETSTR^VALM1(" ","",1,80)
DO TMP
+20 ; -- Cleans up variables set in TRNDATA
DO KILLTRN^VAQUTL92
+21 QUIT
+22 ;
HD ; -- Make header line for list processor
+1 SET X=$$SETSTR^VALM1("Requestor: "_VAQDZN,"",1,79)
+2 SET VALMHDR(1)=" "
SET VALMHDR(2)=X
SET VALMHDR(3)=" "
+3 QUIT
+4 ;
SEL ; -- Selects patient to display, checks sensative patient
+1 NEW VALMY,SDI,SDAT
+2 if '$DATA(VAQBCK)
SET VAQBCK=0
+3 DO EN^VALM2($GET(XQORNOD(0)),"S")
+4 if '$DATA(VALMY)
QUIT
+5 SET SDI=""
+6 SET SDI=$ORDER(VALMY(SDI))
if SDI=""
QUIT
+7 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
+8 SET VAQTRN=$PIECE(SDAT,U,2)
SET DFN=""
+9 SET (VAQDFN,DFN)=$ORDER(^VAT(394.61,"B",VAQTRN,DFN))
+10 IF $PIECE($GET(^VAT(394.61,DFN,0)),U,4)=1
DO WORKLD^VAQDIS11
+11 ; -- Display segments
DO EP^VAQDIS15
+12 IF VAQBCK=1
KILL VALMBCK
QUIT
+13 DO INIT
+14 SET VALMBCK="R"
+15 QUIT
+16 ;
TMP ; -- Set the array used by list processor
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQD1",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 SET ^TMP("VAQD1",$JOB,"IDX",VALMCNT,VAQECNT)=""
+4 SET ^TMP("VAQIDX",$JOB,VAQECNT)=VALMCNT_"^"_VAQTRN
+5 QUIT
+6 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 ;
+3 KILL VAQFLAG,VAQECNT,VAQRSLT,VAQUNSOL,X0,STATUS,TRDE
+4 KILL POP,VAQBCK,VAQDFN,DFN,ENTRY
+5 KILL DATETIME,VAQCSTAT
+6 ; -- set in VAQDIS01 (display min)
KILL VAQADFL
+7 KILL ^TMP("VAQD1",$JOB),^TMP("VAQIDX",$JOB)
+8 QUIT
+9 ;
END ; -- End of code
+1 QUIT
