VAQPST21 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
REQUEST(SITE,DOMAIN,OUTARR,DEBUG) ;CONVERT LOCAL REQUESTS
;INPUT : SITE - Name of local site (used as requesting site)
; DOMAIN - Domain of local site (used as requesting domain)
; OUTARR - Where to store correlation of 1.0 request with it's
; entry in 394.61 (full global reference)
; DEBUG - Turns on debug mode (info written to screen)
; 1 - Debug on
; 0 - Debug off (default)
;OUTPUT : X - Number of requests successfully converted
; -1^Error_Text - Error (nothing converted)
;NOTES : OUTARR will be in the format
; OUTARR(X,Y)=Z
; X = 1.0 request number
; Y = 1.5 request number
; Z = 1.5 IFN
;
;CHECK INPUT
S SITE=$G(SITE)
Q:(SITE="") "-1^Did not pass name of local site"
S DOMAIN=$G(DOMAIN)
Q:(DOMAIN="") "-1^Did not pass domain of local site"
S OUTARR=$G(OUTARR)
Q:(OUTARR="") "-1^Did not pass reference to output array"
S DEBUG=+$G(DEBUG)
N RQSTPTR,ACKPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
N REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
N USER,REMOTE,PTR15,TRAN15,STATUS,RETURN
;DETERMIN CONSTANTS
S RQSTPTR=+$O(^VAT(394.3,"B",10,""))
Q:('RQSTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 10 (request)"
S ACKPTR=+$O(^VAT(394.3,"B",19,""))
Q:('ACKPTR) "-1^PDX STATUS file (#394.3) did not contain status # 19 (acknowledgement)"
W:(DEBUG) !!!!
W:(DEBUG) !,"******************************"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"* Local Request Conversion *"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"******************************"
W:(DEBUG) !!,"Pointer Information"
W:(DEBUG) !,"-------------------"
W:(DEBUG) !,"Request Pointer: ",RQSTPTR
W:(DEBUG) !,"Acknowledgement Pointer: ",ACKPTR
;FILE REQUESTS
W:(DEBUG) !!,"Converting local requests",!," Time: ",$$NOW^VAQUTL99,!
S COUNT=0
S ERRCNT=0
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",RQSTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",RQSTPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",ACKPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",ACKPTR,PTR10)
Q (COUNT-ERRCNT)
;
FILE ;FILE REQUESTS
;INCREMENT COUNT
S COUNT=COUNT+1
I (DEBUG) W:(('(COUNT#5))&(COUNT#100)) "." W:('(COUNT#100)) "#"
;GET INFO FROM 1.0 TRANSACTION
I ('$D(^VAT(394,PTR10))) S ERRCNT=ERRCNT+1 Q
S NODE0=$G(^VAT(394,PTR10,0))
S NODE1=$G(^VAT(394,PTR10,1))
S TRAN10=+$P(NODE0,"^",2)
I ('TRAN10) S ERRCNT=ERRCNT+1 Q
S TMP=+$P(NODE0,"^",12)
I ((TMP'=RQSTPTR)&(TMP'=ACKPTR)) S ERRCNT=ERRCNT+1 Q
S STATUS=$S((TMP=ACKPTR):"VAQ-RQACK",1:"VAQ-RQST")
S PATPTR=$P(NODE0,"^",9)
S NAME=$P(NODE0,"^",4)
S DOB=$P(NODE0,"^",7)
S SSN=$P(NODE0,"^",5)
S PID=$S(SSN="":"",1:($E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)))
I (PATPTR="") S:(SSN'="") PATPTR=$O(^DPT("SSN",SSN,""))
S DATE=$P(NODE0,"^",1)
S USER=$P(NODE0,"^",19)
S REMOTE=$P(NODE0,"^",17)
I (REMOTE) D
.S TMP=+$O(^DIC(4,"D",REMOTE,""))
.Q:('TMP)
.S REMOTE=$P($G(^DIC(4,TMP,0)),"^",1)
.S:(REMOTE="") REMOTE=$P(NODE0,"^",17)
S RELEASE="VAQ-RQST"
S RETURN=""
S REMTRAN=""
;GO TO CONTINUATION ROUTINE
D CNVRT^VAQPST24
;STORE CORRELATION
Q:(('TRAN10)!('$G(TRAN15)))
S @OUTARR@(TRAN10,TRAN15)=PTR15
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST21 3421 printed Oct 16, 2024@18:27:13 Page 2
VAQPST21 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
+1 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
REQUEST(SITE,DOMAIN,OUTARR,DEBUG) ;CONVERT LOCAL REQUESTS
+1 ;INPUT : SITE - Name of local site (used as requesting site)
+2 ; DOMAIN - Domain of local site (used as requesting domain)
+3 ; OUTARR - Where to store correlation of 1.0 request with it's
+4 ; entry in 394.61 (full global reference)
+5 ; DEBUG - Turns on debug mode (info written to screen)
+6 ; 1 - Debug on
+7 ; 0 - Debug off (default)
+8 ;OUTPUT : X - Number of requests successfully converted
+9 ; -1^Error_Text - Error (nothing converted)
+10 ;NOTES : OUTARR will be in the format
+11 ; OUTARR(X,Y)=Z
+12 ; X = 1.0 request number
+13 ; Y = 1.5 request number
+14 ; Z = 1.5 IFN
+15 ;
+16 ;CHECK INPUT
+17 SET SITE=$GET(SITE)
+18 if (SITE="")
QUIT "-1^Did not pass name of local site"
+19 SET DOMAIN=$GET(DOMAIN)
+20 if (DOMAIN="")
QUIT "-1^Did not pass domain of local site"
+21 SET OUTARR=$GET(OUTARR)
+22 if (OUTARR="")
QUIT "-1^Did not pass reference to output array"
+23 SET DEBUG=+$GET(DEBUG)
+24 NEW RQSTPTR,ACKPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
+25 NEW REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
+26 NEW USER,REMOTE,PTR15,TRAN15,STATUS,RETURN
+27 ;DETERMIN CONSTANTS
+28 SET RQSTPTR=+$ORDER(^VAT(394.3,"B",10,""))
+29 if ('RQSTPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 10 (request)"
+30 SET ACKPTR=+$ORDER(^VAT(394.3,"B",19,""))
+31 if ('ACKPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 19 (acknowledgement)"
+32 if (DEBUG)
WRITE !!!!
+33 if (DEBUG)
WRITE !,"******************************"
+34 if (DEBUG)
WRITE !,"* *"
+35 if (DEBUG)
WRITE !,"* Local Request Conversion *"
+36 if (DEBUG)
WRITE !,"* *"
+37 if (DEBUG)
WRITE !,"******************************"
+38 if (DEBUG)
WRITE !!,"Pointer Information"
+39 if (DEBUG)
WRITE !,"-------------------"
+40 if (DEBUG)
WRITE !,"Request Pointer: ",RQSTPTR
+41 if (DEBUG)
WRITE !,"Acknowledgement Pointer: ",ACKPTR
+42 ;FILE REQUESTS
+43 if (DEBUG)
WRITE !!,"Converting local requests",!," Time: ",$$NOW^VAQUTL99,!
+44 SET COUNT=0
+45 SET ERRCNT=0
+46 SET PTR10=0
+47 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",RQSTPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",RQSTPTR,PTR10)
+48 SET PTR10=0
+49 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",ACKPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",ACKPTR,PTR10)
+50 QUIT (COUNT-ERRCNT)
+51 ;
FILE ;FILE REQUESTS
+1 ;INCREMENT COUNT
+2 SET COUNT=COUNT+1
+3 IF (DEBUG)
if (('(COUNT#5))&(COUNT#100))
WRITE "."
if ('(COUNT#100))
WRITE "#"
+4 ;GET INFO FROM 1.0 TRANSACTION
+5 IF ('$DATA(^VAT(394,PTR10)))
SET ERRCNT=ERRCNT+1
QUIT
+6 SET NODE0=$GET(^VAT(394,PTR10,0))
+7 SET NODE1=$GET(^VAT(394,PTR10,1))
+8 SET TRAN10=+$PIECE(NODE0,"^",2)
+9 IF ('TRAN10)
SET ERRCNT=ERRCNT+1
QUIT
+10 SET TMP=+$PIECE(NODE0,"^",12)
+11 IF ((TMP'=RQSTPTR)&(TMP'=ACKPTR))
SET ERRCNT=ERRCNT+1
QUIT
+12 SET STATUS=$SELECT((TMP=ACKPTR):"VAQ-RQACK",1:"VAQ-RQST")
+13 SET PATPTR=$PIECE(NODE0,"^",9)
+14 SET NAME=$PIECE(NODE0,"^",4)
+15 SET DOB=$PIECE(NODE0,"^",7)
+16 SET SSN=$PIECE(NODE0,"^",5)
+17 SET PID=$SELECT(SSN="":"",1:($EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,10)))
+18 IF (PATPTR="")
if (SSN'="")
SET PATPTR=$ORDER(^DPT("SSN",SSN,""))
+19 SET DATE=$PIECE(NODE0,"^",1)
+20 SET USER=$PIECE(NODE0,"^",19)
+21 SET REMOTE=$PIECE(NODE0,"^",17)
+22 IF (REMOTE)
Begin DoDot:1
+23 SET TMP=+$ORDER(^DIC(4,"D",REMOTE,""))
+24 if ('TMP)
QUIT
+25 SET REMOTE=$PIECE($GET(^DIC(4,TMP,0)),"^",1)
+26 if (REMOTE="")
SET REMOTE=$PIECE(NODE0,"^",17)
End DoDot:1
+27 SET RELEASE="VAQ-RQST"
+28 SET RETURN=""
+29 SET REMTRAN=""
+30 ;GO TO CONTINUATION ROUTINE
+31 DO CNVRT^VAQPST24
+32 ;STORE CORRELATION
+33 if (('TRAN10)!('$GET(TRAN15)))
QUIT
+34 SET @OUTARR@(TRAN10,TRAN15)=PTR15
+35 QUIT
