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

VAQLED01.m

Go to the documentation of this file.
  1. VAQLED01 ;ALB/JFP,JRP - PDX LOAD/EDIT, STATUS SCREEN;01MAR93
  1. ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
  1. EP ; -- Main entry point for the list processor
  1. K XQORS,VALMEVL
  1. D EN^VALM("VAQ LED STATUS PDX5") ; -- Protocol = VAQ PDX5 (MENU)
  1. Q
  1. ;
  1. INIT ; -- Build array of PDX transactions for entered patient
  1. K SFLAG,STATPTR,X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SDI
  1. K VALMY,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT,VAQTRNO,VAQDFN
  1. K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
  1. D STATPTR^VAQUTL95 ; -- Set status pointers
  1. S TRDE="",(VAQECNT,VALMCNT)=0
  1. I (VAQISSN="")&(VAQPTNM="") D Q
  1. .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
  1. .S X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80) D TMP
  1. D:$D(XRTL) T0^%ZOSV ; -- Capacity start
  1. F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQPTNM),TRDE)) Q:TRDE="" D SETD
  1. I VAQECNT=0 D
  1. .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
  1. .S X=$$SETSTR^VALM1(" ** PDX results not found for patient entered... ","",1,80) D TMP
  1. S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV
  1. Q
  1. ;
  1. SETD ; -- Set data for display in list processor
  1. N NAME,SSN,TMP
  1. S SFLAG=0
  1. S STATPTR=$P($G(^VAT(394.61,TRDE,0)),U,2)
  1. S:VAQRSLT=STATPTR SFLAG=SFLAG+1
  1. S:VAQUNSOL=STATPTR SFLAG=SFLAG+1
  1. Q:SFLAG=0
  1. ; -- Filter out transactions marked as purged OR excede life cap
  1. S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set from SETD+2
  1. Q:VAQFLAG=1
  1. ;
  1. F ND=0,"QRY","RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
  1. S TRNO=+NODE(0)
  1. S VAQTDTE=$S(((STATPTR=VAQRSLT)!(STATPTR=VAQUNSOL)):+NODE("ATHR1"),1:+NODE("RQST1"))
  1. S DATETIME=$$DOBFMT^VAQUTL99(VAQTDTE,0)
  1. S TMP=$P(VAQTDTE,".",2)_"000000"
  1. S DATETIME=DATETIME_"@"_$E(TMP,1,2)_":"_$E(TMP,3,4)_":"_$E(TMP,5,6)
  1. S DATETIME=DATETIME_$S((STATPTR=VAQRSLT):" (Rs)",(STATPTR=VAQUNSOL):" (Uns)",1:" (Req)")
  1. ;
  1. S DOMAIN=$P(NODE("ATHR2"),U,2)
  1. S VAQECNT=VAQECNT+1
  1. S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
  1. S X=$$SETFLD^VALM1(DOMAIN,X,"DOMAIN")
  1. S X=$$SETFLD^VALM1(DATETIME,X,"DATE")
  1. S X=$$SETFLD^VALM1(TRNO,X,"TRNO")
  1. D TMP
  1. ;GET REQUESTED PATIENT INFO
  1. S NAME=$P(NODE("QRY"),"^",1)
  1. S SSN=$$DASHSSN^VAQUTL99($P(NODE("QRY"),"^",2))
  1. S TMP=NAME_" ("_SSN_")"
  1. S:(STATPTR=VAQUNSOL) TMP="Not Applicable"
  1. S X=" Requested Patient: "_TMP
  1. D TMP
  1. ;GET RELEASED PATIENT INFO
  1. S TMP=$$RLSEPAT^VAQUTL92(TRDE)
  1. S NAME=$P(TMP,"^",1)
  1. S SSN=$$DASHSSN^VAQUTL99($P(TMP,"^",2))
  1. S TMP=NAME_" ("_SSN_")"
  1. S:((STATPTR'=VAQUNSOL)&(STATPTR'=VAQRSLT)) TMP="Not Applicable"
  1. S X=" Released Patient: "_TMP
  1. D TMP
  1. ;BLANK LINE
  1. S X=" " D TMP
  1. Q
  1. ;
  1. TMP ; -- Set the array used by list processor
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("VAQL1",$J,VALMCNT,0)=$E(X,1,79)
  1. S ^TMP("VAQL1",$J,"IDX",VALMCNT,VAQECNT)=""
  1. S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
  1. Q
  1. ;
  1. HD ; -- Make header line for list processor
  1. N TMP
  1. S VALMHDR(1)=" "
  1. S TMP="PDX Transactions referencing "_VAQPTNM_" ("_VAQESSN_")"
  1. S VALMHDR(2)=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
  1. S VALMHDR(3)=" "
  1. Q
  1. ;
  1. LED ; -- load/edit
  1. S ^TMP("VAQL1",$J)=VAQPTNM_"^"_VAQISSN
  1. S VAQBCK=0
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. Q:'$D(VALMY)
  1. D CLEAR^VALM1
  1. D SIGNA ; -- Signature
  1. I VAQSIG<0 K VAQSIG D PAUSE^VAQUTL95 S VALMBCK="R" Q
  1. S SDI=+$O(VALMY(0)) Q:'SDI
  1. S SDAT=$G(^TMP("VAQIDX",$J,SDI))
  1. S VAQTRNO=$P(SDAT,U,2),DFN=""
  1. S DFNTR=+$O(^VAT(394.61,"B",VAQTRNO,0))
  1. S VAQPTID=$$RLSEPAT^VAQUTL92(DFNTR)
  1. S VAQPTNM=$P(VAQPTID,"^",1)
  1. S VAQISSN=$P(VAQPTID,"^",2)
  1. S VAQESSN=$$DASHSSN^VAQUTL99(VAQISSN)
  1. S VAQIDOB=$P(VAQPTID,"^",3)
  1. S VAQEDOB=$$DOBFMT^VAQUTL99(VAQIDOB)
  1. S VAQPTID=""
  1. D EP^VAQLED03 ; -- Finds local matches in database
  1. S SDI=^TMP("VAQL1",$J)
  1. I VAQBCK=1 K VALMBCK Q
  1. S VAQPTNM=$P(SDI,"^",1),VAQISSN=$P(SDI,"^",2)
  1. D INIT
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EXPAND ; -- Displays MAS minimal information from PDX data file (394.62)
  1. D EN^VALM2($G(XQORNOD(0)),"S")
  1. Q:'$D(VALMY)
  1. S SDI=""
  1. F S SDI=$O(VALMY(SDI)) Q:SDI="" D
  1. .S SDAT=$G(^TMP("VAQIDX",$J,SDI))
  1. .S VAQTRNO=$P(SDAT,U,2),DFN=""
  1. .S DFN=$O(^VAT(394.61,"B",VAQTRNO,DFN))
  1. .D TR^VAQDIS01 ; -- expands entry from 394.62 (data file)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CREATE ; -- Creates new patient
  1. D EP^VAQLED07 Q
  1. ;
  1. SIGNA ; -- Signature
  1. S:'$D(VAQSIG) VAQSIG=$$VRFYUSER^VAQAUT(DUZ) Q
  1. ;
  1. EXIT ; -- Note: The list processor cleans up its own variables.
  1. ; All other variables cleaned up here.
  1. K X,Y,ND,NODE,DATETIME,DOMAIN,TRDE,TRNO,SFLAG,STATPTR
  1. K VALMY,SDI,SDAT,DFN,DFNTR,DFNPT,VAQRSLT,VAQUNSOL,VAQECNT
  1. K VAQSIG,VAQTRNO,VAQDFN,VAQPTNM,VAQIDOB,VAQEDOB,VAQISSN,VAQPTID
  1. K VAQCDTE,VAQTDTE,VAQFLAG,VAQBCK
  1. K ^TMP("VAQL1",$J),^TMP("VAQIDX",$J)
  1. K VAQADFL ; -- set in VAQDIS01
  1. Q