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

VAQPST21.m

Go to the documentation of this file. 
  1. VAQPST21 ;ALB/JRP - POST INIT (FILE CONVERSION);11-JUN-93
  1.  ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
  1. REQUEST(SITE,DOMAIN,OUTARR,DEBUG) ;CONVERT LOCAL REQUESTS
  1.  ;INPUT  : SITE - Name of local site (used as requesting site)
  1.  ;         DOMAIN - Domain of local site (used as requesting domain)
  1.  ;         OUTARR - Where to store correlation of 1.0 request with it's
  1.  ;                  entry in 394.61 (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  : OUTARR will be in the format
  1.  ;           OUTARR(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 SITE=$G(SITE)
  1.  Q:(SITE="") "-1^Did not pass name of local site"
  1.  S DOMAIN=$G(DOMAIN)
  1.  Q:(DOMAIN="") "-1^Did not pass domain of local site"
  1.  S OUTARR=$G(OUTARR)
  1.  Q:(OUTARR="") "-1^Did not pass reference to output array"
  1.  S DEBUG=+$G(DEBUG)
  1.  N RQSTPTR,ACKPTR,TMP,NODE0,NODE1,PTR10,TRAN10,COUNT
  1.  N REMTRAN,ERRCNT,RELEASE,PATPTR,NAME,SSN,DOB,PID,DATE
  1.  N USER,REMOTE,PTR15,TRAN15,STATUS,RETURN
  1.  ;DETERMIN CONSTANTS
  1.  S RQSTPTR=+$O(^VAT(394.3,"B",10,""))
  1.  Q:('RQSTPTR) "-1^PDX STATUS file (#394.3) did not contain status # 10 (request)"
  1.  S ACKPTR=+$O(^VAT(394.3,"B",19,""))
  1.  Q:('ACKPTR) "-1^PDX  STATUS file (#394.3) did not contain status # 19 (acknowledgement)"
  1.  W:(DEBUG) !!!!
  1.  W:(DEBUG) !,"******************************"
  1.  W:(DEBUG) !,"*                            *"
  1.  W:(DEBUG) !,"*  Local Request Conversion  *"
  1.  W:(DEBUG) !,"*                            *"
  1.  W:(DEBUG) !,"******************************"
  1.  W:(DEBUG) !!,"Pointer Information"
  1.  W:(DEBUG) !,"-------------------"
  1.  W:(DEBUG) !,"Request Pointer: ",RQSTPTR
  1.  W:(DEBUG) !,"Acknowledgement Pointer: ",ACKPTR
  1.  ;FILE REQUESTS
  1.  W:(DEBUG) !!,"Converting local requests",!,"  Time: ",$$NOW^VAQUTL99,!
  1.  S COUNT=0
  1.  S ERRCNT=0
  1.  S PTR10=0
  1.  F  S PTR10=+$O(^VAT(394,"AD",RQSTPTR,PTR10)) Q:('PTR10)  D FILE K ^VAT(394,"AD",RQSTPTR,PTR10)
  1.  S PTR10=0
  1.  F  S PTR10=+$O(^VAT(394,"AD",ACKPTR,PTR10)) Q:('PTR10)  D FILE K ^VAT(394,"AD",ACKPTR,PTR10)
  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 TMP=+$P(NODE0,"^",12)
  1.  I ((TMP'=RQSTPTR)&(TMP'=ACKPTR)) S ERRCNT=ERRCNT+1 Q
  1.  S STATUS=$S((TMP=ACKPTR):"VAQ-RQACK",1:"VAQ-RQST")
  1.  S PATPTR=$P(NODE0,"^",9)
  1.  S NAME=$P(NODE0,"^",4)
  1.  S DOB=$P(NODE0,"^",7)
  1.  S SSN=$P(NODE0,"^",5)
  1.  S PID=$S(SSN="":"",1:($E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)))
  1.  I (PATPTR="") S:(SSN'="") PATPTR=$O(^DPT("SSN",SSN,""))
  1.  S DATE=$P(NODE0,"^",1)
  1.  S USER=$P(NODE0,"^",19)
  1.  S REMOTE=$P(NODE0,"^",17)
  1.  I (REMOTE) D
  1.  .S TMP=+$O(^DIC(4,"D",REMOTE,""))
  1.  .Q:('TMP)
  1.  .S REMOTE=$P($G(^DIC(4,TMP,0)),"^",1)
  1.  .S:(REMOTE="") REMOTE=$P(NODE0,"^",17)
  1.  S RELEASE="VAQ-RQST"
  1.  S RETURN=""
  1.  S REMTRAN=""
  1.  ;GO TO CONTINUATION ROUTINE
  1.  D CNVRT^VAQPST24
  1.  ;STORE CORRELATION
  1.  Q:(('TRAN10)!('$G(TRAN15)))
  1.  S @OUTARR@(TRAN10,TRAN15)=PTR15
  1.  Q