- VAQREQ01 ;ALB/JFP - PDX, REQUEST PATIENT DATA, STATUS SCREEN;01MAR93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- EP ; -- Main entry point for the list processor
- K XQORS,VALMEVL
- D EN^VALM("VAQ STATUS PDX1")
- QUIT
- ;
- INIT ; -- Builds array of PDX transactions for the patient entered (SSN) or name
- K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
- S TRDE="",(VAQECNT,VALMCNT)=0
- I (VAQISSN="")&(VAQNM="") D QUIT
- .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
- .S X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80) D TMP
- F S TRDE=$O(^VAT(394.61,$S(VAQISSN'="":"SSN",1:"NAME"),$S(VAQISSN'="":VAQISSN,1:VAQNM),TRDE)) Q:TRDE="" D SETD
- I VAQECNT=0 D
- .S TRNO=0,X=$$SETSTR^VALM1(" ","",1,79) D TMP
- .S X=$$SETSTR^VALM1(" ** No PDX transactions found for this patient... ","",1,80) D TMP
- QUIT
- ;
- SETD ; -- Set data for display in list processor
- F ND=0,"RQST1","RQST2","ATHR1","ATHR2" S NODE(ND)=$G(^VAT(394.61,TRDE,ND))
- ; -- Filters out transactions marked as purged OR excides life cap
- S VAQFLAG=$$EXPTRN^VAQUTL97(TRDE) ; -- naked set at SETD+1
- Q:VAQFLAG=1
- ;
- S TRNO=$P(NODE(0),U,1)
- S STDE=$P(NODE(0),U,2)
- S STATUS=$S(STDE'="":$P($G(^VAT(394.85,STDE,0)),U,2),1:" ")
- S VAQTDTE=$P(NODE("ATHR1"),U,1) ; -- response
- I VAQTDTE'="" S Y=VAQTDTE X ^DD("DD") S DATETIME=Y_" (Rs)"
- I VAQTDTE="" S (Y,VAQTDTE)=$P(NODE("RQST1"),U,1) X ^DD("DD") S DATETIME=Y_" (Rq)"
- ;
- S DOMKEY=$$DOMKEY^VAQUTL94(STDE)
- S:DOMKEY=-1 DOMAIN="Error extracting domain"
- S:DOMKEY="R" DOMAIN=$P(NODE("RQST2"),U,1)
- S:DOMKEY="A" DOMAIN=$P(NODE("ATHR2"),U,1)
- S VAQECNT=VAQECNT+1 W:(VAQECNT#10)=0 "."
- D:$D(^VAT(394.61,TRDE,"SEG",0)) SEG^VAQEXT06 ; -- gather segments
- ;
- S X=$$SETSTR^VALM1("Entry # : "_VAQECNT,"",1,30)
- S X=$$SETSTR^VALM1("Trans # : "_TRNO,X,58,21) D TMP
- S X=$$SETSTR^VALM1("Date/Time: "_DATETIME,"",1,80) D TMP
- S X=$$SETSTR^VALM1("Domain : "_DOMAIN,"",1,80) D TMP
- S X=$$SETSTR^VALM1("Status : "_STATUS,"",1,80) D TMP
- F K=0:0 S K=$O(SEGMENT($J,K)) Q:K="" D
- .S SEGMENT=SEGMENT($J,K)
- .I K=1 S X=$$SETSTR^VALM1("Segments : "_SEGMENT,"",1,80) D TMP
- .I K'=1 S X=$$SETSTR^VALM1(" : "_SEGMENT,"",1,80) D TMP
- S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
- QUIT
- ;
- TMP ; -- Set the array used by list processor
- S VALMCNT=VALMCNT+1
- S ^TMP("VAQR1",$J,VALMCNT,0)=$E(X,1,79)
- S ^TMP("VAQR1",$J,"IDX",VALMCNT,VAQECNT)=""
- S ^TMP("VAQIDX",$J,VAQECNT)=VALMCNT_"^"_TRNO
- Q
- ;
- HD ; -- Make header line for list processor
- S SP50=$J("",50)
- S VALMHDR(1)="Patient : "_$E(VAQNM_SP50,1,38)_"Type: "_VAQEELG
- S VALMHDR(2)="Patient SSN: "_$E(VAQESSN_SP50,1,39)_"DOB: "_VAQEDOB
- QUIT
- ;
- DIS ; -- Display PDX data
- N VALMY,SDI,SDAT,VAQRSLT,VAQUNSOL,VAQTRN,VAQBCK
- D STATPTR^VAQUTL95
- S VAQBCK=1
- 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
- I ($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQRSLT)&($P($G(^VAT(394.61,DFN,0)),U,2)'=VAQUNSOL) D QUIT
- .W !," NO Results for transaction selected"
- .D PAUSE^VAQUTL95
- .S VALMBCK="R"
- D EP^VAQDIS15 ; -- Display segments
- I VAQBCK=1 K VALMBCK QUIT
- D INIT
- S VALMBCK="R"
- QUIT
- ;
- EXIT ; -- Note: The list processor cleans up its own variables.
- ; All other variables cleaned up here.
- ;
- K ^TMP("VAQR1",$J),^TMP("VAQIDX",$J)
- K DIC,DIR,NODE,DOMAIN,SEGMENT,SEGMENT($J)
- K TRDE,TRNO,ND,STDE,STATUS,DATETIME,SEGDE,SEG,SP50,VAQECNT,X,K,J
- K VAQFLAG,VAQTDTE,DOMKEY
- Q
- ;
- END ; -- End of code
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQREQ01 3662 printed Feb 18, 2025@23:52:44 Page 2
- VAQREQ01 ;ALB/JFP - PDX, REQUEST PATIENT DATA, STATUS SCREEN;01MAR93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- EP ; -- Main entry point for the list processor
- +1 KILL XQORS,VALMEVL
- +2 DO EN^VALM("VAQ STATUS PDX1")
- +3 QUIT
- +4 ;
- INIT ; -- Builds array of PDX transactions for the patient entered (SSN) or name
- +1 KILL ^TMP("VAQR1",$JOB),^TMP("VAQIDX",$JOB)
- +2 SET TRDE=""
- SET (VAQECNT,VALMCNT)=0
- +3 IF (VAQISSN="")&(VAQNM="")
- Begin DoDot:1
- +4 SET TRNO=0
- SET X=$$SETSTR^VALM1(" ","",1,79)
- DO TMP
- +5 SET X=$$SETSTR^VALM1(" ** Insufficient Information for Patient Look-up...","",1,80)
- DO TMP
- End DoDot:1
- QUIT
- +6 FOR
- SET TRDE=$ORDER(^VAT(394.61,$SELECT(VAQISSN'="":"SSN",1:"NAME"),$SELECT(VAQISSN'="":VAQISSN,1:VAQNM),TRDE))
- if TRDE=""
- QUIT
- DO SETD
- +7 IF VAQECNT=0
- Begin DoDot:1
- +8 SET TRNO=0
- SET X=$$SETSTR^VALM1(" ","",1,79)
- DO TMP
- +9 SET X=$$SETSTR^VALM1(" ** No PDX transactions found for this patient... ","",1,80)
- DO TMP
- End DoDot:1
- +10 QUIT
- +11 ;
- SETD ; -- Set data for display in list processor
- +1 FOR ND=0,"RQST1","RQST2","ATHR1","ATHR2"
- SET NODE(ND)=$GET(^VAT(394.61,TRDE,ND))
- +2 ; -- Filters out transactions marked as purged OR excides life cap
- +3 ; -- naked set at SETD+1
- SET VAQFLAG=$$EXPTRN^VAQUTL97(TRDE)
- +4 if VAQFLAG=1
- QUIT
- +5 ;
- +6 SET TRNO=$PIECE(NODE(0),U,1)
- +7 SET STDE=$PIECE(NODE(0),U,2)
- +8 SET STATUS=$SELECT(STDE'="":$PIECE($GET(^VAT(394.85,STDE,0)),U,2),1:" ")
- +9 ; -- response
- SET VAQTDTE=$PIECE(NODE("ATHR1"),U,1)
- +10 IF VAQTDTE'=""
- SET Y=VAQTDTE
- XECUTE ^DD("DD")
- SET DATETIME=Y_" (Rs)"
- +11 IF VAQTDTE=""
- SET (Y,VAQTDTE)=$PIECE(NODE("RQST1"),U,1)
- XECUTE ^DD("DD")
- SET DATETIME=Y_" (Rq)"
- +12 ;
- +13 SET DOMKEY=$$DOMKEY^VAQUTL94(STDE)
- +14 if DOMKEY=-1
- SET DOMAIN="Error extracting domain"
- +15 if DOMKEY="R"
- SET DOMAIN=$PIECE(NODE("RQST2"),U,1)
- +16 if DOMKEY="A"
- SET DOMAIN=$PIECE(NODE("ATHR2"),U,1)
- +17 SET VAQECNT=VAQECNT+1
- if (VAQECNT#10)=0
- WRITE "."
- +18 ; -- gather segments
- if $DATA(^VAT(394.61,TRDE,"SEG",0))
- DO SEG^VAQEXT06
- +19 ;
- +20 SET X=$$SETSTR^VALM1("Entry # : "_VAQECNT,"",1,30)
- +21 SET X=$$SETSTR^VALM1("Trans # : "_TRNO,X,58,21)
- DO TMP
- +22 SET X=$$SETSTR^VALM1("Date/Time: "_DATETIME,"",1,80)
- DO TMP
- +23 SET X=$$SETSTR^VALM1("Domain : "_DOMAIN,"",1,80)
- DO TMP
- +24 SET X=$$SETSTR^VALM1("Status : "_STATUS,"",1,80)
- DO TMP
- +25 FOR K=0:0
- SET K=$ORDER(SEGMENT($JOB,K))
- if K=""
- QUIT
- Begin DoDot:1
- +26 SET SEGMENT=SEGMENT($JOB,K)
- +27 IF K=1
- SET X=$$SETSTR^VALM1("Segments : "_SEGMENT,"",1,80)
- DO TMP
- +28 IF K'=1
- SET X=$$SETSTR^VALM1(" : "_SEGMENT,"",1,80)
- DO TMP
- End DoDot:1
- +29 ; -- null line
- SET X=$$SETSTR^VALM1(" ","",1,80)
- DO TMP
- +30 QUIT
- +31 ;
- TMP ; -- Set the array used by list processor
- +1 SET VALMCNT=VALMCNT+1
- +2 SET ^TMP("VAQR1",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
- +3 SET ^TMP("VAQR1",$JOB,"IDX",VALMCNT,VAQECNT)=""
- +4 SET ^TMP("VAQIDX",$JOB,VAQECNT)=VALMCNT_"^"_TRNO
- +5 QUIT
- +6 ;
- HD ; -- Make header line for list processor
- +1 SET SP50=$JUSTIFY("",50)
- +2 SET VALMHDR(1)="Patient : "_$EXTRACT(VAQNM_SP50,1,38)_"Type: "_VAQEELG
- +3 SET VALMHDR(2)="Patient SSN: "_$EXTRACT(VAQESSN_SP50,1,39)_"DOB: "_VAQEDOB
- +4 QUIT
- +5 ;
- DIS ; -- Display PDX data
- +1 NEW VALMY,SDI,SDAT,VAQRSLT,VAQUNSOL,VAQTRN,VAQBCK
- +2 DO STATPTR^VAQUTL95
- +3 SET VAQBCK=1
- +4 DO EN^VALM2($GET(XQORNOD(0)),"S")
- +5 if '$DATA(VALMY)
- QUIT
- +6 SET SDI=""
- +7 SET SDI=$ORDER(VALMY(SDI))
- if SDI=""
- QUIT
- +8 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
- +9 SET VAQTRN=$PIECE(SDAT,U,2)
- SET DFN=""
- +10 SET (VAQDFN,DFN)=$ORDER(^VAT(394.61,"B",VAQTRN,DFN))
- +11 IF $PIECE($GET(^VAT(394.61,DFN,0)),U,4)=1
- DO WORKLD^VAQDIS11
- +12 IF ($PIECE($GET(^VAT(394.61,DFN,0)),U,2)'=VAQRSLT)&($PIECE($GET(^VAT(394.61,DFN,0)),U,2)'=VAQUNSOL)
- Begin DoDot:1
- +13 WRITE !," NO Results for transaction selected"
- +14 DO PAUSE^VAQUTL95
- +15 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +16 ; -- Display segments
- DO EP^VAQDIS15
- +17 IF VAQBCK=1
- KILL VALMBCK
- QUIT
- +18 DO INIT
- +19 SET VALMBCK="R"
- +20 QUIT
- +21 ;
- EXIT ; -- Note: The list processor cleans up its own variables.
- +1 ; All other variables cleaned up here.
- +2 ;
- +3 KILL ^TMP("VAQR1",$JOB),^TMP("VAQIDX",$JOB)
- +4 KILL DIC,DIR,NODE,DOMAIN,SEGMENT,SEGMENT($JOB)
- +5 KILL TRDE,TRNO,ND,STDE,STATUS,DATETIME,SEGDE,SEG,SP50,VAQECNT,X,K,J
- +6 KILL VAQFLAG,VAQTDTE,DOMKEY
- +7 QUIT
- +8 ;
- END ; -- End of code
- +1 QUIT