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 Sep 23, 2025@20:02:21 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
