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

VAQREQ01.m

Go to the documentation of this file.
  1. VAQREQ01 ;ALB/JFP - PDX, REQUEST PATIENT DATA, STATUS SCREEN;01MAR93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. EP ; -- Main entry point for the list processor
  1. K XQORS,VALMEVL
  1. D EN^VALM("VAQ STATUS PDX1")
  1. QUIT
  1. ;
  1. INIT ; -- Builds array of PDX transactions for the patient entered (SSN) or name
  1. K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
  1. S TRDE="",(VAQECNT,VALMCNT)=0
  1. I (VAQISSN="")&(VAQNM="") D QUIT
  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. F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQNM),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(" ** No PDX transactions found for this patient... ","",1,80) D TMP
  1. QUIT
  1. ;
  1. SETD ; -- Set data for display in list processor
  1. F ND=0,"RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
  1. ; -- Filters out transactions marked as purged OR excides life cap
  1. S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set at SETD+1
  1. Q:VAQFLAG=1
  1. ;
  1. S TRNO=$P(NODE(0),U,1)
  1. S STDE=$P(NODE(0),U,2)
  1. S STATUS=$S(STDE'="":$P($G(^VAT(394.85,STDE,0)),U,2),1:" ")
  1. S VAQTDTE=$P(NODE("ATHR1"),U,1) ; -- response
  1. I VAQTDTE'="" S Y=VAQTDTE X ^DD("DD") S DATETIME=Y_" (Rs)"
  1. I VAQTDTE="" S (Y,VAQTDTE)=$P(NODE("RQST1"),U,1) X ^DD("DD") S DATETIME=Y_" (Rq)"
  1. ;
  1. S DOMKEY=$$DOMKEY^VAQUTL94(STDE)
  1. S:DOMKEY=-1 DOMAIN="Error extracting domain"
  1. S:DOMKEY="R" DOMAIN=$P(NODE("RQST2"),U,1)
  1. S:DOMKEY="A" DOMAIN=$P(NODE("ATHR2"),U,1)
  1. S VAQECNT=VAQECNT+1 W:(VAQECNT#10)=0 "."
  1. D:$D(^VAT(394.61,TRDE,"SEG",0)) SEG^VAQEXT06 ; -- gather segments
  1. ;
  1. S X=$$SETSTR^VALM1("Entry # : "_VAQECNT,"",1,30)
  1. S X=$$SETSTR^VALM1("Trans # : "_TRNO,X,58,21) D TMP
  1. S X=$$SETSTR^VALM1("Date/Time: "_DATETIME,"",1,80) D TMP
  1. S X=$$SETSTR^VALM1("Domain : "_DOMAIN,"",1,80) D TMP
  1. S X=$$SETSTR^VALM1("Status : "_STATUS,"",1,80) D TMP
  1. F K=0:0 S K=$O(SEGMENT($J,K)) Q:K="" D
  1. .S SEGMENT=SEGMENT($J,K)
  1. .I K=1 S X=$$SETSTR^VALM1("Segments : "_SEGMENT,"",1,80) D TMP
  1. .I K'=1 S X=$$SETSTR^VALM1(" : "_SEGMENT,"",1,80) D TMP
  1. S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
  1. QUIT
  1. ;
  1. TMP ; -- Set the array used by list processor
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("VAQR1",$J,VALMCNT,0)=$E(X,1,79)
  1. S ^TMP("VAQR1",$J,"IDX",VALMCNT,VAQECNT)=""
  1. S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
  1. Q
  1. ;
  1. HD ; -- Make header line for list processor
  1. S SP50=$J("",50)
  1. S VALMHDR(1)="Patient : "_$E(VAQNM_SP50,1,38)_"Type: "_VAQEELG
  1. S VALMHDR(2)="Patient SSN: "_$E(VAQESSN_SP50,1,39)_"DOB: "_VAQEDOB
  1. QUIT
  1. ;
  1. DIS ; -- Display PDX data
  1. N VALMY,SDI,SDAT,VAQRSLT,VAQUNSOL,VAQTRN,VAQBCK
  1. D STATPTR^VAQUTL95
  1. S VAQBCK=1
  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. I ($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQRSLT)&($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQUNSOL) D QUIT
  1. .W !," NO Results for transaction selected"
  1. .D PAUSE^VAQUTL95
  1. .S VALMBCK="R"
  1. D EP^VAQDIS15 ; -- Display segments
  1. I VAQBCK=1 K VALMBCK QUIT
  1. D INIT
  1. S VALMBCK="R"
  1. QUIT
  1. ;
  1. EXIT ; -- Note: The list processor cleans up its own variables.
  1. ; All other variables cleaned up here.
  1. ;
  1. K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
  1. K DIC,DIR,NODE,DOMAIN,SEGMENT,SEGMENT($J)
  1. K TRDE,TRNO,ND,STDE,STATUS,DATETIME,SEGDE,SEG,SP50,VAQECNT,X,K,J
  1. K VAQFLAG,VAQTDTE,DOMKEY
  1. Q
  1. ;
  1. END ; -- End of code
  1. QUIT