- VAQPST23 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- RESULTS(CORARR,DEBUG) ;CONVERT RESULTS OF REQUEST & UNSOLICITED PDXs
- ;INPUT : CORARR - Where correlation of 1.0 request with it's
- ; entry in 394.61 is stored (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 : CORARR will be in the format
- ; CORARR(X,Y)=Z
- ; X = 1.0 request number
- ; Y = 1.5 request number
- ; Z = 1.5 IFN
- ;
- ;CHECK INPUT
- S CORARR=$G(CORARR)
- Q:(CORARR="") "-1^Did not pass reference to correlation array"
- S DEBUG=+$G(DEBUG)
- ;DECLARE VARIABLES
- N AMBGPTR,NTFNPTR,REJPTR,CNTPTR,RSLTPTR,NTRGPTR,UNSPTR
- N COUNT,ERRCNT,PTR10,STATUS,NODE0,NODE1,TMP,TRAN10,TRAN15
- N LINE,PREPAR,BLOCK,XMER,TYPE,PTR15
- ;DETERMIN CONSTANTS
- S PREPAR="^TMP(""VAQ-CNVRT"","_$J_")"
- K @PREPAR
- S AMBGPTR=+$O(^VAT(394.3,"B",11,""))
- Q:('AMBGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 11 (ambiguous)"
- S NTFNPTR=+$O(^VAT(394.3,"B",12,""))
- Q:('NTFNPTR) "-1^PDX STATUS file (#394.3) did not contain status # 12 (not found)"
- S REJPTR=+$O(^VAT(394.3,"B",13,""))
- Q:('REJPTR) "-1^PDX STATUS file (#394.3) did not contain status # 13 (rejected)"
- S CNTPTR=+$O(^VAT(394.3,"B",14,""))
- Q:('CNTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 14 (contact facility)"
- S RSLTPTR=+$O(^VAT(394.3,"B",15,""))
- Q:('RSLTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 15 (results)"
- S UNSPTR=+$O(^VAT(394.3,"B",16,""))
- Q:('UNSPTR) "-1^PDX STATUS file (#394.3) did not contain status # 16 (Unsolicited PDX)"
- S NTRGPTR=+$O(^VAT(394.3,"B",18,""))
- Q:('NTRGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 18 (not registered)"
- W:(DEBUG) !!!!
- W:(DEBUG) !,"*********************"
- W:(DEBUG) !,"* *"
- W:(DEBUG) !,"* PDX Result & *"
- W:(DEBUG) !,"* Unsolicited PDX *"
- W:(DEBUG) !,"* Conversion *"
- W:(DEBUG) !,"* *"
- W:(DEBUG) !,"*********************"
- W:(DEBUG) !!,"Pointer Information"
- W:(DEBUG) !,"-------------------"
- W:(DEBUG) !,"Ambiguous Pointer: ",AMBGPTR
- W:(DEBUG) !,"Not Found Pointer: ",NTFNPTR
- W:(DEBUG) !,"Rejected Pointer: ",REJPTR
- W:(DEBUG) !,"Contact Facility Pointer: ",CNTPTR
- W:(DEBUG) !,"Results Pointer: ",RSLTPTR
- W:(DEBUG) !,"Not Registered Pointer: ",NTRGPTR
- W:(DEBUG) !,"Unsolicited PDX Pointer: ",UNSPTR
- ;FILE RESULTS
- W:(DEBUG) !!,"Converting results",!," Time: ",$$NOW^VAQUTL99,!
- S COUNT=0
- S ERRCNT=0
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",AMBGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",AMBGPTR,PTR10)
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",NTFNPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTFNPTR,PTR10)
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",REJPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",REJPTR,PTR10)
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",CNTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",CNTPTR,PTR10)
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",RSLTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",RSLTPTR,PTR10)
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",NTRGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTRGPTR,PTR10)
- ;FILE UNSOLICITED PDXS
- W:(DEBUG) !!,"Converting Unsolicited PDXs",!," Time: ",$$NOW^VAQUTL99,!
- S PTR10=0
- F S PTR10=+$O(^VAT(394,"AD",UNSPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",UNSPTR,PTR10)
- K @PREPAR
- 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 STATUS=+$P(NODE0,"^",12)
- I ((STATUS'=AMBGPTR)&(STATUS'=NTFNPTR)&(STATUS'=REJPTR)&(STATUS'=CNTPTR)&(STATUS'=RSLTPTR)&(STATUS'=NTRGPTR)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
- ;CONVERT PARENT TRANSACTION NUMBER
- S TMP=+$P(NODE0,"^",3)
- S PARENT=+$O(@CORARR@(TMP,""))
- I (('PARENT)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
- S:(STATUS'=UNSPTR) $P(NODE0,"^",3)=PARENT
- ;GO TO CONTINUATION ROUTINE
- D CNVRT1^VAQPST25
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQPST23 4407 printed Feb 18, 2025@23:52:34 Page 2
- VAQPST23 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- RESULTS(CORARR,DEBUG) ;CONVERT RESULTS OF REQUEST & UNSOLICITED PDXs
- +1 ;INPUT : CORARR - Where correlation of 1.0 request with it's
- +2 ; entry in 394.61 is stored (full global reference)
- +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 : CORARR will be in the format
- +9 ; CORARR(X,Y)=Z
- +10 ; X = 1.0 request number
- +11 ; Y = 1.5 request number
- +12 ; Z = 1.5 IFN
- +13 ;
- +14 ;CHECK INPUT
- +15 SET CORARR=$GET(CORARR)
- +16 if (CORARR="")
- QUIT "-1^Did not pass reference to correlation array"
- +17 SET DEBUG=+$GET(DEBUG)
- +18 ;DECLARE VARIABLES
- +19 NEW AMBGPTR,NTFNPTR,REJPTR,CNTPTR,RSLTPTR,NTRGPTR,UNSPTR
- +20 NEW COUNT,ERRCNT,PTR10,STATUS,NODE0,NODE1,TMP,TRAN10,TRAN15
- +21 NEW LINE,PREPAR,BLOCK,XMER,TYPE,PTR15
- +22 ;DETERMIN CONSTANTS
- +23 SET PREPAR="^TMP(""VAQ-CNVRT"","_$JOB_")"
- +24 KILL @PREPAR
- +25 SET AMBGPTR=+$ORDER(^VAT(394.3,"B",11,""))
- +26 if ('AMBGPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 11 (ambiguous)"
- +27 SET NTFNPTR=+$ORDER(^VAT(394.3,"B",12,""))
- +28 if ('NTFNPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 12 (not found)"
- +29 SET REJPTR=+$ORDER(^VAT(394.3,"B",13,""))
- +30 if ('REJPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 13 (rejected)"
- +31 SET CNTPTR=+$ORDER(^VAT(394.3,"B",14,""))
- +32 if ('CNTPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 14 (contact facility)"
- +33 SET RSLTPTR=+$ORDER(^VAT(394.3,"B",15,""))
- +34 if ('RSLTPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 15 (results)"
- +35 SET UNSPTR=+$ORDER(^VAT(394.3,"B",16,""))
- +36 if ('UNSPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 16 (Unsolicited PDX)"
- +37 SET NTRGPTR=+$ORDER(^VAT(394.3,"B",18,""))
- +38 if ('NTRGPTR)
- QUIT "-1^PDX STATUS file (#394.3) did not contain status # 18 (not registered)"
- +39 if (DEBUG)
- WRITE !!!!
- +40 if (DEBUG)
- WRITE !,"*********************"
- +41 if (DEBUG)
- WRITE !,"* *"
- +42 if (DEBUG)
- WRITE !,"* PDX Result & *"
- +43 if (DEBUG)
- WRITE !,"* Unsolicited PDX *"
- +44 if (DEBUG)
- WRITE !,"* Conversion *"
- +45 if (DEBUG)
- WRITE !,"* *"
- +46 if (DEBUG)
- WRITE !,"*********************"
- +47 if (DEBUG)
- WRITE !!,"Pointer Information"
- +48 if (DEBUG)
- WRITE !,"-------------------"
- +49 if (DEBUG)
- WRITE !,"Ambiguous Pointer: ",AMBGPTR
- +50 if (DEBUG)
- WRITE !,"Not Found Pointer: ",NTFNPTR
- +51 if (DEBUG)
- WRITE !,"Rejected Pointer: ",REJPTR
- +52 if (DEBUG)
- WRITE !,"Contact Facility Pointer: ",CNTPTR
- +53 if (DEBUG)
- WRITE !,"Results Pointer: ",RSLTPTR
- +54 if (DEBUG)
- WRITE !,"Not Registered Pointer: ",NTRGPTR
- +55 if (DEBUG)
- WRITE !,"Unsolicited PDX Pointer: ",UNSPTR
- +56 ;FILE RESULTS
- +57 if (DEBUG)
- WRITE !!,"Converting results",!," Time: ",$$NOW^VAQUTL99,!
- +58 SET COUNT=0
- +59 SET ERRCNT=0
- +60 SET PTR10=0
- +61 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",AMBGPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",AMBGPTR,PTR10)
- +62 SET PTR10=0
- +63 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",NTFNPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",NTFNPTR,PTR10)
- +64 SET PTR10=0
- +65 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",REJPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",REJPTR,PTR10)
- +66 SET PTR10=0
- +67 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",CNTPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",CNTPTR,PTR10)
- +68 SET PTR10=0
- +69 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",RSLTPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",RSLTPTR,PTR10)
- +70 SET PTR10=0
- +71 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",NTRGPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",NTRGPTR,PTR10)
- +72 ;FILE UNSOLICITED PDXS
- +73 if (DEBUG)
- WRITE !!,"Converting Unsolicited PDXs",!," Time: ",$$NOW^VAQUTL99,!
- +74 SET PTR10=0
- +75 FOR
- SET PTR10=+$ORDER(^VAT(394,"AD",UNSPTR,PTR10))
- if ('PTR10)
- QUIT
- DO FILE
- KILL ^VAT(394,"AD",UNSPTR,PTR10)
- +76 KILL @PREPAR
- +77 QUIT (COUNT-ERRCNT)
- +78 ;
- 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 STATUS=+$PIECE(NODE0,"^",12)
- +11 IF ((STATUS'=AMBGPTR)&(STATUS'=NTFNPTR)&(STATUS'=REJPTR)&(STATUS'=CNTPTR)&(STATUS'=RSLTPTR)&(STATUS'=NTRGPTR)&(STATUS'=UNSPTR))
- SET ERRCNT=ERRCNT+1
- QUIT
- +12 ;CONVERT PARENT TRANSACTION NUMBER
- +13 SET TMP=+$PIECE(NODE0,"^",3)
- +14 SET PARENT=+$ORDER(@CORARR@(TMP,""))
- +15 IF (('PARENT)&(STATUS'=UNSPTR))
- SET ERRCNT=ERRCNT+1
- QUIT
- +16 if (STATUS'=UNSPTR)
- SET $PIECE(NODE0,"^",3)=PARENT
- +17 ;GO TO CONTINUATION ROUTINE
- +18 DO CNVRT1^VAQPST25
- +19 QUIT