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

PSUAA1.m

Go to the documentation of this file.
  1. PSUAA1 ;BIR/RDC - ALLERGY/ADVERSE EVENT EXTRACT ; 4/5/12 7:25am
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**10,14,20**;MARCH, 2005;Build 4
  1. ;
  1. ; Reference to file #4 supported by DBIA 10090
  1. ; Reference to file #2 supported by DBIA 10035 AND 3504
  1. ; Reference to file #120.8 supported by DBIA 10099, 2422, AND 4562
  1. ; Reference to file #120.85 supported by DBIA 10099
  1. ; Reference to file #49 supported by DBIA 432
  1. ;
  1. EN ; *20 Fix typo
  1. N ARTMP,DFN,EDATE,GMRA,GMRACT,GMRAL,GMREC,ICN,K,LINECNT,LINEMAX,LINETOT,MSGCNT,NPTR,OPTR,OREC,PN,PREC,RPTR,RRDT,RREC,SDATE,SSN,STATION,V,VPTR,X,Z
  1. K PSUMKFLG
  1. ;
  1. D INITZ
  1. D GETRECS
  1. D ^PSUAA2
  1. Q
  1. ;
  1. INITZ ;
  1. ; ** new all non-namespaced variables **
  1. ;
  1. S SDATE=PSUSDT\1-.0001
  1. S EDATE=PSUEDT\1+.2359
  1. ;
  1. S LINEMAX=$$VAL^PSUTL(4.3,1,8.3)
  1. S:LINEMAX=""!(LINEMAX>10000) LINEMAX=10000
  1. S LINECNT=999999
  1. S LINETOT=0
  1. ;
  1. S PSUFAC=PSUSNDR
  1. ;
  1. ; ** get station number **
  1. S X=$$VALI^PSUTL(4.3,1,217)
  1. S STATION=+$$VAL^PSUTL(4,X,99)
  1. ;
  1. ; ** get run date **
  1. S %H=$H
  1. D YMD^%DTC
  1. S $P(^TMP("PSUAA",$J),U,3)=X
  1. ;
  1. ;
  1. Q ; ** end of partition initialization **
  1. ;
  1. GETRECS ; ; ** extract reactive data **
  1. F S SDATE=$O(^GMR(120.8,"V",SDATE)) Q:SDATE>EDATE!('SDATE) D
  1. . S VPTR="" ;*** loop through verified dates ***
  1. . F S VPTR=$O(^GMR(120.8,"V",SDATE,VPTR)) Q:VPTR="" D
  1. .. K GMRACT,GMRAL,GMREC
  1. .. S PSUMKFLG=0
  1. .. S VREC=^GMR(120.8,VPTR,0)
  1. .. S DFN=$P(VREC,U)
  1. .. Q:$G(DFN)=""
  1. .. Q:$$TESTPAT^VADPT(DFN)=1 ;test patient
  1. .. S PREC=$G(^DPT(DFN,0))
  1. .. S SSN=$P(PREC,U,9)
  1. .. S GMRA="0^1^111"
  1. .. D EN1^GMRADPT
  1. .. Q:'$D(GMRAL(VPTR))
  1. .. S GMREC=GMRAL(VPTR)
  1. .. D EN1^GMRAOR2(VPTR,.ARTMP) ; ** load multiple variables **
  1. .. S Z="$",OREC=""
  1. .. D STATIC
  1. .. S V="" F S V=$O(GMRACT("S",V)) Q:V=""!(V=7) D
  1. ... S $P(OREC,Z,13+V)=$G(GMRACT("S",V)) ; * symptoms
  1. .. S $P(OREC,Z,20)=""
  1. .. S V="" F S V=$O(GMRACT("O",V)) Q:V=""!(V=7) D
  1. ... S $P(OREC,Z,12)=$P(GMRACT("O",V),U) ; * event date
  1. ... S $P(OREC,Z,13)=$P(GMRACT("O",V),U,2) ; * severity
  1. ... ;PSU*4*14 add reverse translation.
  1. ... D MAKE1 S PSUMKFLG=1,OREC=$TR(OREC,"^",Z)
  1. .. D:'$G(PSUMKFLG) MAKE1 ; ** load ^XTMP with OREC **
  1. .. S:$G(MSGCNT) ^XTMP("PSU_"_PSUJOB,"PSUAA","MSGTCNT")=MSGCNT
  1. .. S:LINECNT=999999 LINECNT=1
  1. .. S:$G(LINECNT) ^XTMP("PSU_"_PSUJOB,"PSUAA","LINECNT")=LINECNT
  1. Q
  1. ;
  1. STATIC ; ** set static pieces of record into OREC **
  1. ;
  1. S $P(OREC,Z,1)=""
  1. S $P(OREC,Z,2)=STATION_VPTR ; ** event ID
  1. S $P(OREC,Z,3)=SSN ; ** social security #
  1. ;
  1. S ICN=$$GETICN^MPIF001(DFN) ; ** ICN
  1. I $E(ICN,1,2)="-1" S ICN=""
  1. S $P(OREC,Z,4)=ICN
  1. ;
  1. S $P(OREC,Z,5)=$P(GMREC,U,2) ; ** reactant
  1. S $P(OREC,Z,6)=$P($P($P(GMREC,U,9),"(",2),",") ; * reactant file #
  1. S $P(OREC,Z,7)=$P(GMREC,U,7) ; ** allergy type
  1. S $P(OREC,Z,8)=$P(VREC,U,4) ; ** origination date
  1. ;
  1. S NPTR=$P(VREC,U,5) ; * originator's section/service
  1. I NPTR S OPTR=$P($G(^VA(200,NPTR,5)),U,1)
  1. I OPTR S $P(OREC,Z,9)=$P(^DIC(49,OPTR,0),U,1)
  1. ;
  1. S $P(OREC,Z,10)=$P(VREC,U,6) ; ** observed/historical
  1. S $P(OREC,Z,11)=$P(VREC,U,14) ; ** mechanism
  1. ;
  1. Q ; ** end of static variables for a message **
  1. ;
  1. MAKE1 ; ** load one record/message **
  1. ;
  1. S OREC=$TR(OREC,"^","'")
  1. S OREC=$TR(OREC,Z,U)
  1. ;
  1. S LINECNT=LINECNT+1
  1. S LINETOT=LINETOT+1
  1. I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
  1. I $L(OREC)<254 S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)=OREC Q
  1. ;PSU*4*14 Add infinite loop safety.
  1. F K=254:-1:0 Q:$E(OREC,K)="^"
  1. S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)=$E(OREC,1,K)
  1. S LINECNT=LINECNT+1
  1. S LINETOT=LINETOT+1
  1. ;*20 Remove duplicate "^" from $E
  1. S ^XTMP("PSU_"_PSUJOB,"PSUAA",MSGCNT,LINECNT)="*"_$E(OREC,K+1,K+253)
  1. Q
  1. PRINT ; *20 Update Comment
  1. ; Printing of Allergies/Adverse Events.
  1. ; Called from PSUCP. No longer used.
  1. Q
  1. ;