VAQUIN01 ;ALB/JFP - REQUEST PDX RECORD - (API);3JUL91
;;1.5;PATIENT DATA EXCHANGE;**43**;NOV 17, 1993
; Programmer entry point for sending PDX requests.
;
; This API can be used for both request and unsolicited.
; It also utilizes time and occurrence limits for Health Summary
; which are pieces on the segment root array. These pieces need
; to be set by the developer. If these are not included the defaults
; in the sites PDX parameter file will be used.
;
PDX(VAQOPT,VAQDFN,VAQNM,VAQISSN,VAQIDOB,DOMROOT,SEGROOT,NOTROOT) ; EP
;Input: VAQOPT - REQ = request, UNS = unsolicited
; VAQDFN - IFN of patient in patient file
; VAQNM - name of patient
; VAQISSN - patient social security number (no dashes)
; VAQIDOB - patients date of birth (external format)
; DOMROOT - array of domains (full global reference)
; (ie: PXB.ISC-ALBANY.DOMAIN.EXT)=Institution name or null
; SEGROOT - array of segments (full global reference)
; (ie: PDX*MIN)=P1^P2
; P1 = TIME LIMIT
; P2 = OCCURRENCE LIMIT
; NOTROOT - array of who to notify (only used for request)
; TLIMIT - time limit for health summary (ie: 1D,12M,5Y)
; OLIMIT - occurrence limit for health summary, up to 5 digits
;
;Output: 0 - ok
; -1^error text
; -- Initialize
N POP,ERR,VAQ0,Y,XMITARR,X,VAQDOM,VAQPID,VAQRQDT,PARMNODE,FACDA,DOMDA
N VAQRQSIT,VAQRQADD,VAQDZ,VAQDZN,VAQPR,DA,DR,VAQDT,SEG
N VAQAUSIT,VAQNOTI
N OLDEF,TLDEF,TLMT,OLMT
; -- CHECK INPUT PARAMETERS
S POP=0
Q:('$D(VAQOPT)) "-1^option required"
I (VAQOPT'="REQ")&(VAQOPT'="UNS") Q "-1^option required"
Q:('$D(DOMROOT)) "-1^reference to domain required for processing"
Q:($O(@DOMROOT@(""))="") "-1^domain data required for processing"
Q:('$D(SEGROOT)) "-1^reference to segment required for processing"
Q:($O(@SEGROOT@("")))="" "-1^segment data required for processing"
;
S:'$D(VAQDFN) VAQDFN=""
I VAQDFN="" D Q:POP=1 ERR
.I '$D(VAQNM) S POP=1,ERR="-1^Name is required if DFN is null" QUIT
.I '$D(VAQISSN) S POP=1,ERR="-1^SSN is required if DFN is null" QUIT
.I '$D(VAQNM)&'$D(VAQISSN) S POP=1,ERR="-1^name and SSN is required if DFN=null" QUIT
.I (VAQNM="")&(VAQISSN="") S POP=1,ERR="-1^name and SSN is required if DFN=null" QUIT
.S:'$D(VAQIDOB) VAQIDOB=""
I VAQDFN'="" D Q:POP=1 ERR
.I VAQDFN<1 S POP=1,ERR="-1^DFN can not be less than 1" QUIT
.I '$D(^DPT(VAQDFN)) S POP=1,ERR="-1^DFN is not in data base" QUIT
.S VAQ0=$G(^DPT(VAQDFN,0))
.S VAQNM=$P(VAQ0,U,1)
.S (VAQISSN)=$P(VAQ0,U,9)
.S (Y,VAQIDOB)=$P(VAQ0,U,3) X ^DD("DD") S VAQIDOB=Y
I (VAQNM="")&(VAQISSN="") Q "-1^name or SSN is required"
;
S XMITARR="^TMP(""TRANARR"","_$J_")"
K @XMITARR
D PRELOAD^VAQREQ06
S VAQDOM=""
F S VAQDOM=$O(@DOMROOT@(VAQDOM)) Q:VAQDOM="" D XMIT
S X=$$GENTASK^VAQADM5(XMITARR)
I +X=-1 S ERR="-1^"_$P(X,U,2) Q ERR
K @XMITARR
QUIT 0
;
XMIT ; -- Make an entry in the 'PDX TRANSACTION' FILE
S X="+" ; -- auto number
S DIC="^VAT(394.61,",DIC(0)="L",DLAYGO=394.61
D ^DIC K DIC,X,DLAYGO
Q:Y<0
S (VAQPR,DA)=+Y,VAQDT=$P(Y,U,2)
; -- FILL IN REST OF FIELDS OF 'TRANSACTION' FILE
I VAQOPT="REQ" D LDREQ^VAQREQ06
I VAQOPT="UNS" D LDUNS^VAQREQ06
I $D(@SEGROOT) D MSEG
I (VAQOPT="REQ")&($D(NOTIROOT)) D:$D(@NOTROOT) MNOTI
S @XMITARR@(VAQPR)="" ; -- Load an array of newly entered transactions
; -- Update workload file
S X=$$WORKDONE^VAQADS01($S(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$G(DUZ))
QUIT
;
MSEG ; -- Loads the data segment multiple
S PARAMND=$G(^VAT(394.81,1,"LIMITS")) ; -- Sets defaults from PDX param
S TLDEF=$P(PARAMND,U,1)
S OLDEF=$P(PARAMND,U,2)
;
S DIE="^VAT(394.61,",SEG=""
F S SEG=$O(@SEGROOT@(SEG)) Q:SEG="" D
.S HSCOMPND=$$HLTHSEG^VAQDBIH1(SEG,0)
.I $P(HSCOMPND,U,1)=0 S (TLMT,OLMT)="" ; -- Not health summary segment
.I $P(HSCOMPND,U,1)'=0 D
..S SEGND=$G(@SEGROOT@(SEG))
..S TLMT=$P(SEGND,U,1),OLMT=$P(SEGND,U,2)
..I (TLMT="")&($P(HSCOMPND,U,2)=1) S TLMT=TLDEF
..I (OLMT="")&($P(HSCOMPND,U,3)=1) S OLMT=OLDEF
..I $P(HSCOMPND,U,2)=0 S TLMT=""
..I $P(HSCOMPND,U,3)=0 S OLMT=""
.S DR(2,394.618)=".02///"_TLMT_";.03///"_OLMT
.S DR="80///"_SEG
.D ^DIE
K DIE,DR,DLAYGO
QUIT
;
MNOTI ; -- Loads the notify muliple
S DIE="^VAT(394.61,",DLAYGO=394.61,NOTI=""
F S NOTI=$O(@NOTROOT@(NOTI)) Q:NOTI="" D
.S DR="71///"_NOTI
.D ^DIE
K DIE,DR,DLAYGO
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQUIN01 4561 printed Apr 09, 2024@21:27:56 Page 2
VAQUIN01 ;ALB/JFP - REQUEST PDX RECORD - (API);3JUL91
+1 ;;1.5;PATIENT DATA EXCHANGE;**43**;NOV 17, 1993
+2 ; Programmer entry point for sending PDX requests.
+3 ;
+4 ; This API can be used for both request and unsolicited.
+5 ; It also utilizes time and occurrence limits for Health Summary
+6 ; which are pieces on the segment root array. These pieces need
+7 ; to be set by the developer. If these are not included the defaults
+8 ; in the sites PDX parameter file will be used.
+9 ;
PDX(VAQOPT,VAQDFN,VAQNM,VAQISSN,VAQIDOB,DOMROOT,SEGROOT,NOTROOT) ; EP
+1 ;Input: VAQOPT - REQ = request, UNS = unsolicited
+2 ; VAQDFN - IFN of patient in patient file
+3 ; VAQNM - name of patient
+4 ; VAQISSN - patient social security number (no dashes)
+5 ; VAQIDOB - patients date of birth (external format)
+6 ; DOMROOT - array of domains (full global reference)
+7 ; (ie: PXB.ISC-ALBANY.DOMAIN.EXT)=Institution name or null
+8 ; SEGROOT - array of segments (full global reference)
+9 ; (ie: PDX*MIN)=P1^P2
+10 ; P1 = TIME LIMIT
+11 ; P2 = OCCURRENCE LIMIT
+12 ; NOTROOT - array of who to notify (only used for request)
+13 ; TLIMIT - time limit for health summary (ie: 1D,12M,5Y)
+14 ; OLIMIT - occurrence limit for health summary, up to 5 digits
+15 ;
+16 ;Output: 0 - ok
+17 ; -1^error text
+18 ; -- Initialize
+19 NEW POP,ERR,VAQ0,Y,XMITARR,X,VAQDOM,VAQPID,VAQRQDT,PARMNODE,FACDA,DOMDA
+20 NEW VAQRQSIT,VAQRQADD,VAQDZ,VAQDZN,VAQPR,DA,DR,VAQDT,SEG
+21 NEW VAQAUSIT,VAQNOTI
+22 NEW OLDEF,TLDEF,TLMT,OLMT
+23 ; -- CHECK INPUT PARAMETERS
+24 SET POP=0
+25 if ('$DATA(VAQOPT))
QUIT "-1^option required"
+26 IF (VAQOPT'="REQ")&(VAQOPT'="UNS")
QUIT "-1^option required"
+27 if ('$DATA(DOMROOT))
QUIT "-1^reference to domain required for processing"
+28 if ($ORDER(@DOMROOT@(""))="")
QUIT "-1^domain data required for processing"
+29 if ('$DATA(SEGROOT))
QUIT "-1^reference to segment required for processing"
+30 if ($ORDER(@SEGROOT@("")))=""
QUIT "-1^segment data required for processing"
+31 ;
+32 if '$DATA(VAQDFN)
SET VAQDFN=""
+33 IF VAQDFN=""
Begin DoDot:1
+34 IF '$DATA(VAQNM)
SET POP=1
SET ERR="-1^Name is required if DFN is null"
QUIT
+35 IF '$DATA(VAQISSN)
SET POP=1
SET ERR="-1^SSN is required if DFN is null"
QUIT
+36 IF '$DATA(VAQNM)&'$DATA(VAQISSN)
SET POP=1
SET ERR="-1^name and SSN is required if DFN=null"
QUIT
+37 IF (VAQNM="")&(VAQISSN="")
SET POP=1
SET ERR="-1^name and SSN is required if DFN=null"
QUIT
+38 if '$DATA(VAQIDOB)
SET VAQIDOB=""
End DoDot:1
if POP=1
QUIT ERR
+39 IF VAQDFN'=""
Begin DoDot:1
+40 IF VAQDFN<1
SET POP=1
SET ERR="-1^DFN can not be less than 1"
QUIT
+41 IF '$DATA(^DPT(VAQDFN))
SET POP=1
SET ERR="-1^DFN is not in data base"
QUIT
+42 SET VAQ0=$GET(^DPT(VAQDFN,0))
+43 SET VAQNM=$PIECE(VAQ0,U,1)
+44 SET (VAQISSN)=$PIECE(VAQ0,U,9)
+45 SET (Y,VAQIDOB)=$PIECE(VAQ0,U,3)
XECUTE ^DD("DD")
SET VAQIDOB=Y
End DoDot:1
if POP=1
QUIT ERR
+46 IF (VAQNM="")&(VAQISSN="")
QUIT "-1^name or SSN is required"
+47 ;
+48 SET XMITARR="^TMP(""TRANARR"","_$JOB_")"
+49 KILL @XMITARR
+50 DO PRELOAD^VAQREQ06
+51 SET VAQDOM=""
+52 FOR
SET VAQDOM=$ORDER(@DOMROOT@(VAQDOM))
if VAQDOM=""
QUIT
DO XMIT
+53 SET X=$$GENTASK^VAQADM5(XMITARR)
+54 IF +X=-1
SET ERR="-1^"_$PIECE(X,U,2)
QUIT ERR
+55 KILL @XMITARR
+56 QUIT 0
+57 ;
XMIT ; -- Make an entry in the 'PDX TRANSACTION' FILE
+1 ; -- auto number
SET X="+"
+2 SET DIC="^VAT(394.61,"
SET DIC(0)="L"
SET DLAYGO=394.61
+3 DO ^DIC
KILL DIC,X,DLAYGO
+4 if Y<0
QUIT
+5 SET (VAQPR,DA)=+Y
SET VAQDT=$PIECE(Y,U,2)
+6 ; -- FILL IN REST OF FIELDS OF 'TRANSACTION' FILE
+7 IF VAQOPT="REQ"
DO LDREQ^VAQREQ06
+8 IF VAQOPT="UNS"
DO LDUNS^VAQREQ06
+9 IF $DATA(@SEGROOT)
DO MSEG
+10 IF (VAQOPT="REQ")&($DATA(NOTIROOT))
if $DATA(@NOTROOT)
DO MNOTI
+11 ; -- Load an array of newly entered transactions
SET @XMITARR@(VAQPR)=""
+12 ; -- Update workload file
+13 SET X=$$WORKDONE^VAQADS01($SELECT(VAQOPT="REQ":"RQST",VAQOPT="UNS":"SEND",1:""),VAQPR,$GET(DUZ))
+14 QUIT
+15 ;
MSEG ; -- Loads the data segment multiple
+1 ; -- Sets defaults from PDX param
SET PARAMND=$GET(^VAT(394.81,1,"LIMITS"))
+2 SET TLDEF=$PIECE(PARAMND,U,1)
+3 SET OLDEF=$PIECE(PARAMND,U,2)
+4 ;
+5 SET DIE="^VAT(394.61,"
SET SEG=""
+6 FOR
SET SEG=$ORDER(@SEGROOT@(SEG))
if SEG=""
QUIT
Begin DoDot:1
+7 SET HSCOMPND=$$HLTHSEG^VAQDBIH1(SEG,0)
+8 ; -- Not health summary segment
IF $PIECE(HSCOMPND,U,1)=0
SET (TLMT,OLMT)=""
+9 IF $PIECE(HSCOMPND,U,1)'=0
Begin DoDot:2
+10 SET SEGND=$GET(@SEGROOT@(SEG))
+11 SET TLMT=$PIECE(SEGND,U,1)
SET OLMT=$PIECE(SEGND,U,2)
+12 IF (TLMT="")&($PIECE(HSCOMPND,U,2)=1)
SET TLMT=TLDEF
+13 IF (OLMT="")&($PIECE(HSCOMPND,U,3)=1)
SET OLMT=OLDEF
+14 IF $PIECE(HSCOMPND,U,2)=0
SET TLMT=""
+15 IF $PIECE(HSCOMPND,U,3)=0
SET OLMT=""
End DoDot:2
+16 SET DR(2,394.618)=".02///"_TLMT_";.03///"_OLMT
+17 SET DR="80///"_SEG
+18 DO ^DIE
End DoDot:1
+19 KILL DIE,DR,DLAYGO
+20 QUIT
+21 ;
MNOTI ; -- Loads the notify muliple
+1 SET DIE="^VAT(394.61,"
SET DLAYGO=394.61
SET NOTI=""
+2 FOR
SET NOTI=$ORDER(@NOTROOT@(NOTI))
if NOTI=""
QUIT
Begin DoDot:1
+3 SET DR="71///"_NOTI
+4 DO ^DIE
End DoDot:1
+5 KILL DIE,DR,DLAYGO
+6 QUIT
+7 ;
