VAQREQ06 ;ALB/JFP - REQUEST PDX RECORD,TRANSMIT;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**4,20,26,32,44**;NOV 17, 1993;Build 4
EP ; -- Programmer entry point for sending PDX requests
; -- This code is used by both request and unsolicited request
;
D:$D(XRTL) T0^%ZOSV ; -- Capacity start
S VAQDOM="",(POP,DOMCNT)=0 W !!,"Working..."
D PRELOAD
F S VAQDOM=$O(^TMP("VAQSEG",$J,VAQDOM)) Q:VAQDOM="" D XMIT
I POP K POP QUIT
S VAQFLAG=1
W !!,"Transactions filed "
TASK ; -- Load taskman variables and task off
S ZTRTN="GENXMIT^VAQADM50"
S ZTDESC=$S(VAQOPT="REQ":"PDX, REQUEST",VAQOPT="UNS":"PDX, UNSOLICITED",1:"PDX, GENERATE TRANSMISSION")
S ZTDTH=$H,ZTIO=""
S ZTSAVE("VAQTRN(")=""
I ZTRTN'="" D ^%ZTLOAD
I $D(ZTSK) W "and queued "
K ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
K ^TMP("CMNT",$J),FACDA,NOTI,PARMNODE,DOMDA,X,Y,DOMCNT,LOAD
S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
QUIT
;
XMIT ; -- Makes an entry in the 'PDX TRANSACTION' file
S Y=$$NEWTRAN^VAQFILE Q:Y<0
S DOMCNT=DOMCNT+1 W:(DOMCNT#10)=0 "."
S (VAQPR,DA)=+Y,VAQTRN=$P(Y,"^",2)
S LOAD=$S(VAQOPT="REQ":"LDREQ",VAQOPT="UNS":"LDUNS",1:"LDREQ")
D @LOAD
D:$D(^TMP("VAQNOTI",$J)) MNOTI
D:$D(^TMP("VAQSEG",$J)) MSEG
I VAQOPT="UNS"&($D(^TMP("CMNT",$J))) D CMNT
; -- Load an array of newly entered transactions
S VAQTRN(VAQPR)=""
; -- Updates workload file
S X=$$WORKDONE^VAQADS01($S(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$G(DUZ))
Q
;
PRELOAD ; -- Loads the constant data for multiple domains
S %DT="ST",X="NOW" D ^%DT S VAQRQDT=Y
S VAQPID=""
S VAQSENPT=""
I VAQDFN>0 D
.S DFN=+VAQDFN
.D PID^VADPT6
.S VAQPID=$P($G(VA("PID")),U,1)
.K VA("PID"),VA("BID")
.S VAQSENPT=$$GETSEN^VAQUTL97(DFN) ; --Sensitive patient
.S:VAQSENPT<0 VAQSENPT=""
;
S PARMNODE=$G(^VAT(394.81,1,0))
S FACDA=$P(PARMNODE,U,1),DOMDA=$P(PARMNODE,U,2)
S VAQRQSIT=$P($G(^DIC(4,FACDA,0)),U,1)
S VAQRQADD=$P($G(^DIC(4.2,DOMDA,0)),U,1)
;
S (VAQDZ,VAQDZN)=""
I $G(DUZ)'="" D
.S VAQDZN=$S($D(DUZ):$P(^VA(200,DUZ,0),U,1),1:"")
.S VAQDZ=$S($D(DUZ):DUZ,1:"")
QUIT
;
LDREQ ; -- Sets DR string and non-constant variables, LOAD FOR REQUEST
S:'$D(VAQNOTI) VAQNOTI=0 ; -- UNS does not use notify logic
S VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
S DR=".02///VAQ-RQST"
S DR(1,394.61,.03)=".03////"_$S(+VAQDFN>0:+VAQDFN,1:"")
S DR(1,394.61,.04)=".04///"_VAQSENPT
S DR(1,394.61,.05)=".05///VAQ-RQST"
S DR(1,394.61,10)="10///"_VAQNM
S DR(1,394.61,11)="11///"_VAQISSN
S DR(1,394.61,12)="12///"_VAQIDOB
S DR(1,394.61,13)="13///"_VAQPID
S DR(1,394.61,20)="20///"_VAQRQDT
S DR(1,394.61,21)="21///"_VAQDZN
S DR(1,394.61,30)="30///"_VAQRQSIT
S DR(1,394.61,31)="31///"_VAQRQADD
S DR(1,394.61,60)="60///"_VAQAUSIT
S DR(1,394.61,61)="61///"_VAQDOM
S DR(1,394.61,70)="70///"_VAQNOTI
;
S DIE="^VAT(394.61,"
D ^DIE K DIE,DR
QUIT
;
LDUNS ; -- Sets DR string and non-constant variables, LOAD FOR UNSOLICITED
S VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
S DR=".02///VAQ-TUNSL"
S DR(1,394.61,.03)=".03////"_$S(+VAQDFN>0:+VAQDFN,1:"")
S DR(1,394.61,.04)=".04///"_VAQSENPT
S DR(1,394.61,.05)=".05///VAQ-UNSOL"
S DR(1,394.61,10)="10///"_VAQNM
S DR(1,394.61,11)="11///"_VAQISSN
S DR(1,394.61,12)="12///"_VAQIDOB
S DR(1,394.61,13)="13///"_VAQPID
S DR(1,394.61,20)="20///"_VAQRQDT
S DR(1,394.61,21)="21///"_VAQDZN
S DR(1,394.61,50)="50///"_VAQRQDT
S DR(1,394.61,51)="51///"_VAQDZN
S DR(1,394.61,30)="60///"_VAQRQSIT
S DR(1,394.61,31)="61///"_VAQRQADD
S DR(1,394.61,60)="30///"_VAQAUSIT
S DR(1,394.61,61)="31///"_VAQDOM
;
S DIE="^VAT(394.61,"
D ^DIE K DIE,DR
QUIT
MNOTI ; -- Loads the notify multiple
N VAQNOTI,VAQNTF,VAQMSG
S NOTI=""
F S NOTI=$O(^TMP("VAQNOTI",$J,NOTI)) Q:NOTI="" D
.;RRA VAQ*1.5*44 TICKET 485092 pass "Notify" ien rather than name as string (dups)
.S VAQNOTI=$G(^TMP("VAQNOTI",$J,NOTI))
.S VAQNTF(394.6171,"+1,"_VAQPR_",",.01)=VAQNOTI
.D UPDATE^DIE("","VAQNTF",,"VAQMSG")
.K VAQNTF,VAQMSG
K DIE,DR,DLAYGO
QUIT
;
MSEG ; -- Loads the data segment muliple
S SEG=""
F S SEG=$O(^TMP("VAQSEG",$J,VAQDOM,SEG)) Q:(SEG="") D
.S SEGND=$G(^TMP("VAQSEG",$J,VAQDOM,SEG))
.S VAQJUNK=$$FILESEG^VAQFILE2(394.61,VAQPR,80,$P(SEGND,"^",1),$P(SEGND,"^",3),$P(SEGND,"^",4))
K VAQJUNK
QUIT
;
CMNT ; -- Loads comment for unsolicited request (WORD PROCESSOR FIELD)
S %X="^TMP(""CMNT"",$J,"
S %Y="^VAT(394.61,"_DA_",""CMNT"","
D %XY^%RCR
K %X,%Y
QUIT
;
END ; -- End of code
;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQREQ06 4531 printed Sep 23, 2025@20:02:25 Page 2
VAQREQ06 ;ALB/JFP - REQUEST PDX RECORD,TRANSMIT;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**4,20,26,32,44**;NOV 17, 1993;Build 4
EP ; -- Programmer entry point for sending PDX requests
+1 ; -- This code is used by both request and unsolicited request
+2 ;
+3 ; -- Capacity start
if $DATA(XRTL)
DO T0^%ZOSV
+4 SET VAQDOM=""
SET (POP,DOMCNT)=0
WRITE !!,"Working..."
+5 DO PRELOAD
+6 FOR
SET VAQDOM=$ORDER(^TMP("VAQSEG",$JOB,VAQDOM))
if VAQDOM=""
QUIT
DO XMIT
+7 IF POP
KILL POP
QUIT
+8 SET VAQFLAG=1
+9 WRITE !!,"Transactions filed "
TASK ; -- Load taskman variables and task off
+1 SET ZTRTN="GENXMIT^VAQADM50"
+2 SET ZTDESC=$SELECT(VAQOPT="REQ":"PDX, REQUEST",VAQOPT="UNS":"PDX, UNSOLICITED",1:"PDX, GENERATE TRANSMISSION")
+3 SET ZTDTH=$HOROLOG
SET ZTIO=""
+4 SET ZTSAVE("VAQTRN(")=""
+5 IF ZTRTN'=""
DO ^%ZTLOAD
+6 IF $DATA(ZTSK)
WRITE "and queued "
+7 KILL ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+8 KILL ^TMP("CMNT",$JOB),FACDA,NOTI,PARMNODE,DOMDA,X,Y,DOMCNT,LOAD
+9 ; -- Capacity stop
if $DATA(XRT0)
SET XRTN=$TEXT(+0)
if $DATA(XRT0)
DO T1^%ZOSV
+10 QUIT
+11 ;
XMIT ; -- Makes an entry in the 'PDX TRANSACTION' file
+1 SET Y=$$NEWTRAN^VAQFILE
if Y<0
QUIT
+2 SET DOMCNT=DOMCNT+1
if (DOMCNT#10)=0
WRITE "."
+3 SET (VAQPR,DA)=+Y
SET VAQTRN=$PIECE(Y,"^",2)
+4 SET LOAD=$SELECT(VAQOPT="REQ":"LDREQ",VAQOPT="UNS":"LDUNS",1:"LDREQ")
+5 DO @LOAD
+6 if $DATA(^TMP("VAQNOTI",$JOB))
DO MNOTI
+7 if $DATA(^TMP("VAQSEG",$JOB))
DO MSEG
+8 IF VAQOPT="UNS"&($DATA(^TMP("CMNT",$JOB)))
DO CMNT
+9 ; -- Load an array of newly entered transactions
+10 SET VAQTRN(VAQPR)=""
+11 ; -- Updates workload file
+12 SET X=$$WORKDONE^VAQADS01($SELECT(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$GET(DUZ))
+13 QUIT
+14 ;
PRELOAD ; -- Loads the constant data for multiple domains
+1 SET %DT="ST"
SET X="NOW"
DO ^%DT
SET VAQRQDT=Y
+2 SET VAQPID=""
+3 SET VAQSENPT=""
+4 IF VAQDFN>0
Begin DoDot:1
+5 SET DFN=+VAQDFN
+6 DO PID^VADPT6
+7 SET VAQPID=$PIECE($GET(VA("PID")),U,1)
+8 KILL VA("PID"),VA("BID")
+9 ; --Sensitive patient
SET VAQSENPT=$$GETSEN^VAQUTL97(DFN)
+10 if VAQSENPT<0
SET VAQSENPT=""
End DoDot:1
+11 ;
+12 SET PARMNODE=$GET(^VAT(394.81,1,0))
+13 SET FACDA=$PIECE(PARMNODE,U,1)
SET DOMDA=$PIECE(PARMNODE,U,2)
+14 SET VAQRQSIT=$PIECE($GET(^DIC(4,FACDA,0)),U,1)
+15 SET VAQRQADD=$PIECE($GET(^DIC(4.2,DOMDA,0)),U,1)
+16 ;
+17 SET (VAQDZ,VAQDZN)=""
+18 IF $GET(DUZ)'=""
Begin DoDot:1
+19 SET VAQDZN=$SELECT($DATA(DUZ):$PIECE(^VA(200,DUZ,0),U,1),1:"")
+20 SET VAQDZ=$SELECT($DATA(DUZ):DUZ,1:"")
End DoDot:1
+21 QUIT
+22 ;
LDREQ ; -- Sets DR string and non-constant variables, LOAD FOR REQUEST
+1 ; -- UNS does not use notify logic
if '$DATA(VAQNOTI)
SET VAQNOTI=0
+2 SET VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
+3 SET DR=".02///VAQ-RQST"
+4 SET DR(1,394.61,.03)=".03////"_$SELECT(+VAQDFN>0:+VAQDFN,1:"")
+5 SET DR(1,394.61,.04)=".04///"_VAQSENPT
+6 SET DR(1,394.61,.05)=".05///VAQ-RQST"
+7 SET DR(1,394.61,10)="10///"_VAQNM
+8 SET DR(1,394.61,11)="11///"_VAQISSN
+9 SET DR(1,394.61,12)="12///"_VAQIDOB
+10 SET DR(1,394.61,13)="13///"_VAQPID
+11 SET DR(1,394.61,20)="20///"_VAQRQDT
+12 SET DR(1,394.61,21)="21///"_VAQDZN
+13 SET DR(1,394.61,30)="30///"_VAQRQSIT
+14 SET DR(1,394.61,31)="31///"_VAQRQADD
+15 SET DR(1,394.61,60)="60///"_VAQAUSIT
+16 SET DR(1,394.61,61)="61///"_VAQDOM
+17 SET DR(1,394.61,70)="70///"_VAQNOTI
+18 ;
+19 SET DIE="^VAT(394.61,"
+20 DO ^DIE
KILL DIE,DR
+21 QUIT
+22 ;
LDUNS ; -- Sets DR string and non-constant variables, LOAD FOR UNSOLICITED
+1 SET VAQAUSIT=$$GETINST^VAQUTL97(VAQDOM)
+2 SET DR=".02///VAQ-TUNSL"
+3 SET DR(1,394.61,.03)=".03////"_$SELECT(+VAQDFN>0:+VAQDFN,1:"")
+4 SET DR(1,394.61,.04)=".04///"_VAQSENPT
+5 SET DR(1,394.61,.05)=".05///VAQ-UNSOL"
+6 SET DR(1,394.61,10)="10///"_VAQNM
+7 SET DR(1,394.61,11)="11///"_VAQISSN
+8 SET DR(1,394.61,12)="12///"_VAQIDOB
+9 SET DR(1,394.61,13)="13///"_VAQPID
+10 SET DR(1,394.61,20)="20///"_VAQRQDT
+11 SET DR(1,394.61,21)="21///"_VAQDZN
+12 SET DR(1,394.61,50)="50///"_VAQRQDT
+13 SET DR(1,394.61,51)="51///"_VAQDZN
+14 SET DR(1,394.61,30)="60///"_VAQRQSIT
+15 SET DR(1,394.61,31)="61///"_VAQRQADD
+16 SET DR(1,394.61,60)="30///"_VAQAUSIT
+17 SET DR(1,394.61,61)="31///"_VAQDOM
+18 ;
+19 SET DIE="^VAT(394.61,"
+20 DO ^DIE
KILL DIE,DR
+21 QUIT
MNOTI ; -- Loads the notify multiple
+1 NEW VAQNOTI,VAQNTF,VAQMSG
+2 SET NOTI=""
+3 FOR
SET NOTI=$ORDER(^TMP("VAQNOTI",$JOB,NOTI))
if NOTI=""
QUIT
Begin DoDot:1
+4 ;RRA VAQ*1.5*44 TICKET 485092 pass "Notify" ien rather than name as string (dups)
+5 SET VAQNOTI=$GET(^TMP("VAQNOTI",$JOB,NOTI))
+6 SET VAQNTF(394.6171,"+1,"_VAQPR_",",.01)=VAQNOTI
+7 DO UPDATE^DIE("","VAQNTF",,"VAQMSG")
+8 KILL VAQNTF,VAQMSG
End DoDot:1
+9 KILL DIE,DR,DLAYGO
+10 QUIT
+11 ;
MSEG ; -- Loads the data segment muliple
+1 SET SEG=""
+2 FOR
SET SEG=$ORDER(^TMP("VAQSEG",$JOB,VAQDOM,SEG))
if (SEG="")
QUIT
Begin DoDot:1
+3 SET SEGND=$GET(^TMP("VAQSEG",$JOB,VAQDOM,SEG))
+4 SET VAQJUNK=$$FILESEG^VAQFILE2(394.61,VAQPR,80,$PIECE(SEGND,"^",1),$PIECE(SEGND,"^",3),$PIECE(SEGND,"^",4))
End DoDot:1
+5 KILL VAQJUNK
+6 QUIT
+7 ;
CMNT ; -- Loads comment for unsolicited request (WORD PROCESSOR FIELD)
+1 SET %X="^TMP(""CMNT"",$J,"
+2 SET %Y="^VAT(394.61,"_DA_",""CMNT"","
+3 DO %XY^%RCR
+4 KILL %X,%Y
+5 QUIT
+6 ;
END ; -- End of code
+1 ;QUIT
