Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQDIS12

VAQDIS12.m

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