Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQPST23

VAQPST23.m

Go to the documentation of this file.
  1. VAQPST23 ;ALB/JRP - POST INIT (FILE CONVERSION);29-JUL-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. RESULTS(CORARR,DEBUG) ;CONVERT RESULTS OF REQUEST & UNSOLICITED PDXs
  1. ;INPUT : CORARR - Where correlation of 1.0 request with it's
  1. ; entry in 394.61 is stored (full global reference)
  1. ; DEBUG - Turns on debug mode (info written to screen)
  1. ; 1 - Debug on
  1. ; 0 - Debug off (default)
  1. ;OUTPUT : X - Number of requests successfully converted
  1. ; -1^Error_Text - Error (nothing converted)
  1. ;NOTES : CORARR will be in the format
  1. ; CORARR(X,Y)=Z
  1. ; X = 1.0 request number
  1. ; Y = 1.5 request number
  1. ; Z = 1.5 IFN
  1. ;
  1. ;CHECK INPUT
  1. S CORARR=$G(CORARR)
  1. Q:(CORARR="") "-1^Did not pass reference to correlation array"
  1. S DEBUG=+$G(DEBUG)
  1. ;DECLARE VARIABLES
  1. N AMBGPTR,NTFNPTR,REJPTR,CNTPTR,RSLTPTR,NTRGPTR,UNSPTR
  1. N COUNT,ERRCNT,PTR10,STATUS,NODE0,NODE1,TMP,TRAN10,TRAN15
  1. N LINE,PREPAR,BLOCK,XMER,TYPE,PTR15
  1. ;DETERMIN CONSTANTS
  1. S PREPAR="^TMP(""VAQ-CNVRT"","_$J_")"
  1. K @PREPAR
  1. S AMBGPTR=+$O(^VAT(394.3,"B",11,""))
  1. Q:('AMBGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 11 (ambiguous)"
  1. S NTFNPTR=+$O(^VAT(394.3,"B",12,""))
  1. Q:('NTFNPTR) "-1^PDX STATUS file (#394.3) did not contain status # 12 (not found)"
  1. S REJPTR=+$O(^VAT(394.3,"B",13,""))
  1. Q:('REJPTR) "-1^PDX STATUS file (#394.3) did not contain status # 13 (rejected)"
  1. S CNTPTR=+$O(^VAT(394.3,"B",14,""))
  1. Q:('CNTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 14 (contact facility)"
  1. S RSLTPTR=+$O(^VAT(394.3,"B",15,""))
  1. Q:('RSLTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 15 (results)"
  1. S UNSPTR=+$O(^VAT(394.3,"B",16,""))
  1. Q:('UNSPTR) "-1^PDX STATUS file (#394.3) did not contain status # 16 (Unsolicited PDX)"
  1. S NTRGPTR=+$O(^VAT(394.3,"B",18,""))
  1. Q:('NTRGPTR) "-1^PDX STATUS file (#394.3) did not contain status # 18 (not registered)"
  1. W:(DEBUG) !!!!
  1. W:(DEBUG) !,"*********************"
  1. W:(DEBUG) !,"* *"
  1. W:(DEBUG) !,"* PDX Result & *"
  1. W:(DEBUG) !,"* Unsolicited PDX *"
  1. W:(DEBUG) !,"* Conversion *"
  1. W:(DEBUG) !,"* *"
  1. W:(DEBUG) !,"*********************"
  1. W:(DEBUG) !!,"Pointer Information"
  1. W:(DEBUG) !,"-------------------"
  1. W:(DEBUG) !,"Ambiguous Pointer: ",AMBGPTR
  1. W:(DEBUG) !,"Not Found Pointer: ",NTFNPTR
  1. W:(DEBUG) !,"Rejected Pointer: ",REJPTR
  1. W:(DEBUG) !,"Contact Facility Pointer: ",CNTPTR
  1. W:(DEBUG) !,"Results Pointer: ",RSLTPTR
  1. W:(DEBUG) !,"Not Registered Pointer: ",NTRGPTR
  1. W:(DEBUG) !,"Unsolicited PDX Pointer: ",UNSPTR
  1. ;FILE RESULTS
  1. W:(DEBUG) !!,"Converting results",!," Time: ",$$NOW^VAQUTL99,!
  1. S COUNT=0
  1. S ERRCNT=0
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",AMBGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",AMBGPTR,PTR10)
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",NTFNPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTFNPTR,PTR10)
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",REJPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",REJPTR,PTR10)
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",CNTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",CNTPTR,PTR10)
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",RSLTPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",RSLTPTR,PTR10)
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",NTRGPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",NTRGPTR,PTR10)
  1. ;FILE UNSOLICITED PDXS
  1. W:(DEBUG) !!,"Converting Unsolicited PDXs",!," Time: ",$$NOW^VAQUTL99,!
  1. S PTR10=0
  1. F S PTR10=+$O(^VAT(394,"AD",UNSPTR,PTR10)) Q:('PTR10) D FILE K ^VAT(394,"AD",UNSPTR,PTR10)
  1. K @PREPAR
  1. Q (COUNT-ERRCNT)
  1. ;
  1. FILE ;FILE REQUESTS
  1. ;INCREMENT COUNT
  1. S COUNT=COUNT+1
  1. I (DEBUG) W:(('(COUNT#5))&(COUNT#100)) "." W:('(COUNT#100)) "#"
  1. ;GET INFO FROM 1.0 TRANSACTION
  1. I ('$D(^VAT(394,PTR10))) S ERRCNT=ERRCNT+1 Q
  1. S NODE0=$G(^VAT(394,PTR10,0))
  1. S NODE1=$G(^VAT(394,PTR10,1))
  1. S TRAN10=+$P(NODE0,"^",2)
  1. I ('TRAN10) S ERRCNT=ERRCNT+1 Q
  1. S STATUS=+$P(NODE0,"^",12)
  1. I ((STATUS'=AMBGPTR)&(STATUS'=NTFNPTR)&(STATUS'=REJPTR)&(STATUS'=CNTPTR)&(STATUS'=RSLTPTR)&(STATUS'=NTRGPTR)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
  1. ;CONVERT PARENT TRANSACTION NUMBER
  1. S TMP=+$P(NODE0,"^",3)
  1. S PARENT=+$O(@CORARR@(TMP,""))
  1. I (('PARENT)&(STATUS'=UNSPTR)) S ERRCNT=ERRCNT+1 Q
  1. S:(STATUS'=UNSPTR) $P(NODE0,"^",3)=PARENT
  1. ;GO TO CONTINUATION ROUTINE
  1. D CNVRT1^VAQPST25
  1. Q