VAQPST22 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PROCESS(REMOTE,RETURN,DEBUG) ;CONVERT REMOTE REQUESTS
;INPUT : REMOTE - Name of local site (used as authorizing site)
; RETURN - Domain of local site (used as authorizing domain)
; 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 : All remote requests will be stored as requires manual
; processing (even if they are marked for automatic)
;
;CHECK INPUT
S REMOTE=$G(REMOTE)
Q:(REMOTE="") "-1^Did not pass name of local site"
S RETURN=$G(RETURN)
Q:(RETURN="") "-1^Did not pass domain of local site"
S DEBUG=+$G(DEBUG)
N AUTOPTR,MANPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
N REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
N USER,SITE,PTR15,TRAN15,STATUS,DOMAIN
;DETERMIN CONSTANTS
S AUTOPTR=+$O(^VAT(394.3,"B",20,""))
Q:('AUTOPTR) "-1^PDX STATUS file (#394.3) did not contain status # 20 (automatic processing)"
S MANPTR=+$O(^VAT(394.3,"B",17,""))
Q:('MANPTR) "-1^PDX STATUS file (#394.3) did not contain status # 17 (requires processing)"
W:(DEBUG) !!!!
W:(DEBUG) !,"*******************************"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"* Remote Request Conversion *"
W:(DEBUG) !,"* *"
W:(DEBUG) !,"*******************************"
W:(DEBUG) !!,"Pointer Information"
W:(DEBUG) !,"-------------------"
W:(DEBUG) !,"Automatic Processing Pointer: ",AUTOPTR
W:(DEBUG) !,"Requires Processing Pointer: ",MANPTR
;FILE REMOTE REQUESTS
W:(DEBUG) !!,"Converting remote requests ",!," Time: ",$$NOW^VAQUTL99,!
S COUNT=0
S ERRCNT=0
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",AUTOPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",AUTOPTR,PTR10)
S PTR10=0
F S PTR10=+$O(^VAT(394,"AD",MANPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",MANPTR,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'=AUTOPTR)&(TMP'=MANPTR)) S ERRCNT=ERRCNT+1 Q
S STATUS="VAQ-PROC"
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 SITE=$P(NODE0,"^",17)
I (SITE) D
.S TMP=+$O(^DIC(4,"D",SITE,""))
.Q:('TMP)
.S SITE=$P($G(^DIC(4,TMP,0)),"^",1)
.S:(SITE="") SITE=$P(NODE0,"^",17)
S DOMAIN=$P(NODE1,"^",1)
I (DOMAIN="") S ERRCNT=ERRCNT+1 Q
S REMTRAN=$P(NODE0,"^",3)
S RELEASE="VAQ-RQACK"
;GO TO CONTINUATION ROUTINE
D CNVRT^VAQPST24
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST22 3140 printed Nov 22, 2024@17:36:33 Page 2
VAQPST22 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PROCESS(REMOTE,RETURN,DEBUG) ;CONVERT REMOTE REQUESTS
+1 ;INPUT : REMOTE - Name of local site (used as authorizing site)
+2 ; RETURN - Domain of local site (used as authorizing domain)
+3 ; DEBUG - Turns on debug mode (info written to screen)
+4 ; 1 - Debug on
+5 ; 0 - Debug off (default)
+6 ;OUTPUT : X - Number of requests successfully converted
+7 ; -1^Error_Text - Error (nothing converted)
+8 ;NOTES : All remote requests will be stored as requires manual
+9 ; processing (even if they are marked for automatic)
+10 ;
+11 ;CHECK INPUT
+12 SET REMOTE=$GET(REMOTE)
+13 if (REMOTE="")
QUIT "-1^Did not pass name of local site"
+14 SET RETURN=$GET(RETURN)
+15 if (RETURN="")
QUIT "-1^Did not pass domain of local site"
+16 SET DEBUG=+$GET(DEBUG)
+17 NEW AUTOPTR,MANPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
+18 NEW REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
+19 NEW USER,SITE,PTR15,TRAN15,STATUS,DOMAIN
+20 ;DETERMIN CONSTANTS
+21 SET AUTOPTR=+$ORDER(^VAT(394.3,"B",20,""))
+22 if ('AUTOPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 20 (automatic processing)"
+23 SET MANPTR=+$ORDER(^VAT(394.3,"B",17,""))
+24 if ('MANPTR)
QUIT "-1^PDX STATUS file (#394.3) did not contain status # 17 (requires processing)"
+25 if (DEBUG)
WRITE !!!!
+26 if (DEBUG)
WRITE !,"*******************************"
+27 if (DEBUG)
WRITE !,"* *"
+28 if (DEBUG)
WRITE !,"* Remote Request Conversion *"
+29 if (DEBUG)
WRITE !,"* *"
+30 if (DEBUG)
WRITE !,"*******************************"
+31 if (DEBUG)
WRITE !!,"Pointer Information"
+32 if (DEBUG)
WRITE !,"-------------------"
+33 if (DEBUG)
WRITE !,"Automatic Processing Pointer: ",AUTOPTR
+34 if (DEBUG)
WRITE !,"Requires Processing Pointer: ",MANPTR
+35 ;FILE REMOTE REQUESTS
+36 if (DEBUG)
WRITE !!,"Converting remote requests ",!," Time: ",$$NOW^VAQUTL99,!
+37 SET COUNT=0
+38 SET ERRCNT=0
+39 SET PTR10=0
+40 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",AUTOPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",AUTOPTR,PTR10)
+41 SET PTR10=0
+42 FOR
SET PTR10=+$ORDER(^VAT(394,"AD",MANPTR,PTR10))
if ('PTR10)
QUIT
DO FILE
KILL ^VAT(394,"AD",MANPTR,PTR10)
+43 QUIT (COUNT-ERRCNT)
+44 ;
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'=AUTOPTR)&(TMP'=MANPTR))
SET ERRCNT=ERRCNT+1
QUIT
+12 SET STATUS="VAQ-PROC"
+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 SITE=$PIECE(NODE0,"^",17)
+22 IF (SITE)
Begin DoDot:1
+23 SET TMP=+$ORDER(^DIC(4,"D",SITE,""))
+24 if ('TMP)
QUIT
+25 SET SITE=$PIECE($GET(^DIC(4,TMP,0)),"^",1)
+26 if (SITE="")
SET SITE=$PIECE(NODE0,"^",17)
End DoDot:1
+27 SET DOMAIN=$PIECE(NODE1,"^",1)
+28 IF (DOMAIN="")
SET ERRCNT=ERRCNT+1
QUIT
+29 SET REMTRAN=$PIECE(NODE0,"^",3)
+30 SET RELEASE="VAQ-RQACK"
+31 ;GO TO CONTINUATION ROUTINE
+32 DO CNVRT^VAQPST24
+33 QUIT
