- 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 Jan 18, 2025@03:26:01 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