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

PSUVIT1.m

Go to the documentation of this file. 
  1. PSUVIT1 ;BIR/RDC - VITALS & IMMUNIZATION EXTRACT; 24 DEC 2003 ; 1/12/09 12:07pm
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;**11,15**;MARCH, 2005;Build 2
  1.  ;
  1.  ;DBIA's
  1.  ;References to file #4       - the INSTITUTION file
  1.  ;  DBIA 10090 for: the STATION field  - #99
  1.  ;
  1.  ;References to file #120.5    - the GMRV VITAL MEASUREMENT file
  1.  ;  DBIA 1381 for:   the DATE/TIME VITALS TAKEN field - #.01
  1.  ;                   the VITAL TYPE field #.03
  1.  ;                   the RATE field #1.2
  1.  ;                   the QUALIFIER field #5
  1.  ;
  1.  ;References to file #120.51- the GMRV VITAL TYPE file
  1.  ;       DBIA 1382 for: the NAME field - #.01
  1.  ;
  1.  ;References to file #120.52 - the GMRV VITAL QUALIFIER file
  1.  ;       DBIA 4504 for: the QUALIFIER field #.01
  1.  ;
  1.  ;References to file #9000010.11 - the V IMMUNIZATION file
  1.  ;       DBIA 4567 for: the EVENT DATE AND TIME field #1202
  1.  ;                      the IMMUNIZATION field #.01
  1.  ;
  1.  ;References to file #2   - the PATIENT file
  1.  ;       DBIA 10035 for:  the SOCIAL SECURITY NUMBER field #.09
  1.  ;       DBIA 3504 for: the TEST PATIENT INDICATOR field #.6
  1.  ;
  1.  ;References to file #9999999.14 - the IMMUNIZATION file
  1.  ;       DBIA 2454 for: the NAME field #.01
  1.  ;
  1. EN ;ENtry POINT - Routine control module
  1.  ;
  1.  N SDATE,EDATE,PSUFAC,PSUIDATE,PSUQCNT,PSUQNUM
  1.  N MAXLINE,LINECNT,MSGCNT,I,J,K,Z,LINETOT
  1.  S PSUVTMP(0)="TEMP ARRAY FOR PSUVIT1 PROCESSING"
  1.  D SETUP
  1.  D VITALS
  1.  D VITALS2
  1.  D IMMUNS
  1.  D MAILIT
  1.  Q          ;  **  end of routine control module **
  1.  ; 
  1. SETUP ; SET UP PARTITION FOR VITALS/IMMUNIZATION EXTRACT
  1.  ;
  1.  S LINEMAX=$$VAL^PSUTL(4.3,1,8.3)       ; ** get maximum line length **
  1.  S:LINEMAX=""!(LINEMAX>10000) LINEMAX=10000
  1.  ;
  1.  ; SET EXTRACT DATE
  1.  S %H=$H
  1.  D YMD^%DTC
  1.  S $P(^TMP("PSUVI",$J),U,3)=X
  1.  ;
  1.  ; GET TIME WINDOW
  1.  S SDATE=PSUSDT\1-.0001
  1.  S EDATE=PSUEDT\1+.2359
  1.  ;
  1.  ; GET FACILITY
  1.  S PSUFAC=PSUSNDR
  1.  ; 
  1.  ; SET VARIABLES
  1.  I $G(^XTMP("PSU_"_PSUJOB,"PSUPSUFLAG"))=1 D  ;AUTOJOBED
  1.  . S PSUOPTS="1,2,3,4,5,6,7,8,9,10,11,12,13"
  1.  . S PSUAUTO=1
  1.  S LINECNT=999999
  1.  S LINETOT=0
  1.  ;
  1.  Q                         ;  ** end of SETUP  **
  1.  ;
  1. VITALS ; EXTRACT VITAL DATA
  1.  ; 
  1.  N PSUDATE,PSUV,PSUQ,PSUVREC,PSUPTREC,PSUPTPTR,PSUVPTR,PSUQPTR
  1.  N PSURTYPE,PSUSSN,PSUICN,PSUVTYPE,PSUVRATE,PSUVUNIT
  1.  N Z,QQ,PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4,PSUVLIST,PSUVMSG
  1.  N PSULN,PSUTXT
  1.  ;
  1.  S PSUVLIST="""BLOOD PRESSURE"",""HEIGHT"",""WEIGHT"",""PAIN"",""PULSE"",""PULSE OXIMETRY"""
  1.  ;
  1.  ;                          ** Loop through date index for valid dates **
  1.  S PSUDATE=SDATE
  1.  ;PSU*4*11 Added null ptr notification.
  1.  S PSUTXT(1)="The following IEN(s) have a null pointer in the PATIENT (#2) field of"
  1.  S PSUTXT(2)="the GMRV VITAL MEASUREMENT file (#120.5).  Please notify your IRM and"
  1.  S PSUTXT(3)="submit a remedy ticket for help in evaluating the record."
  1.  S PSULN=3
  1.  F  S PSUDATE=$O(^GMR(120.5,"B",PSUDATE)) Q:PSUDATE>EDATE!('PSUDATE)  D
  1.  . S PSUV=""                      ; ** loop thru vitals for each date **
  1.  . F  S PSUV=$O(^GMR(120.5,"B",PSUDATE,PSUV)) Q:PSUV=""  D
  1.  .. Q:$P($D(^GMR(120.5,PSUV,2)),U)  ;** quit if vital entered in error **
  1.  .. S PSUVREC=$G(^GMR(120.5,PSUV,0)) Q:'PSUVREC
  1.  .. S PSUPTPTR=$P(PSUVREC,U,2)    ; ** point to PATIENT **
  1.  .. I PSUPTPTR="" D  Q            ; ** quit if no patient pointer **
  1.  ... S PSULN=PSULN+1
  1.  ... S PSUTXT(PSULN)=PSUV
  1.  .. Q:$G(^DPT(PSUPTPTR,0))=""     ; ** quit if no patient record **
  1.  .. S PSUPTREC=^DPT(PSUPTPTR,0)   ; ** get patient record **
  1.  .. S PSUSSN=$P(PSUPTREC,U,9)     ; ** get SSN
  1.  .. ;PSU*4*15
  1.  .. Q:'PSUSSN                     ; ** Quit if no SSN **
  1.  .. Q:$E(PSUSSN,1,5)="00000"      ; ** quit if invalid patient **
  1.  .. Q:$P(PSUPTREC,U,21)=1
  1.  .. Q:$P(PSUVREC,U,3)=""          ; ** quit if no pointer **
  1.  .. S PSUVPTR=$P(PSUVREC,U,3)     ; ** point to VITAL  **
  1.  .. S PSUVTYPE=$P(^GMRD(120.51,PSUVPTR,0),U)  ; ** get VITAL TYPE **
  1.  .. Q:PSUVLIST'[PSUVTYPE         ; ** screen out invalid vital types **
  1.  .. S PSURTYPE="V"                ; ** set record type **
  1.  .. S PSUICN=$$GETICN^MPIF001(PSUPTPTR)  ; ** get ICN **
  1.  .. I $P(PSUICN,U)="-1" S PSUICN=""
  1.  .. S PSUVRATE=$P(PSUVREC,U,8)
  1.  .. S PSUVUNIT=""                 ; ** set vital unit rate **
  1.  .. S:PSUVTYPE="PULSE OXIMETRY" PSUVUNIT="%"
  1.  .. S:PSUVTYPE="WEIGHT" PSUVUNIT="LBS"
  1.  .. S:PSUVTYPE="HEIGHT" PSUVUNIT="IN"
  1.  .. S (PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4)=""
  1.  .. D:$D(^GMR(120.5,PSUV,5,0))    ; ** get qualifiers **
  1.  ... S (PSUQNUM,PSUQCNT)=0
  1.  ... F  S PSUQNUM=$O(^GMR(120.5,PSUV,5,PSUQNUM)) Q:'+PSUQNUM  D
  1.  .... S PSUQPTR=^GMR(120.5,PSUV,5,PSUQNUM,0)
  1.  .... S PSUQCNT=PSUQCNT+1
  1.  .... S QQ="PSUVQ"_PSUQCNT
  1.  .... S @QQ=$P(^GMRD(120.52,PSUQPTR,0),U)
  1.  .. S Z="$"
  1.  .. S PSUVMSG=Z_PSUFAC_Z_PSUDATE_Z_PSURTYPE_Z_PSUSSN_Z_PSUICN_Z_""_Z_PSUVTYPE_Z_PSUVRATE_Z_PSUVUNIT_Z_PSUVQ1_Z_PSUVQ2_Z_PSUVQ3_Z_PSUVQ4_Z
  1.  .. S PSUVMSG=$TR(PSUVMSG,"^","'")
  1.  .. S PSUVMSG=$TR(PSUVMSG,Z,U)
  1.  .. ; ** S PSUVTMP(PSUSSN,PSUVTYPE)=PSUVMSG
  1.  .. S ^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",PSUSSN,PSUVTYPE)=PSUVMSG
  1.  ;PSU*4*11 Send null ptr notifications to PBM group.
  1.  I PSULN>3 D
  1.  . S XMTEXT="PSUTXT(",XMY("G.PSU PBM")=""
  1.  . S XMSUB="** PBM vitals extract detected null patient pointer(s) **"
  1.  . S XMDUZ="Pharmacy Benefits Management Package"
  1.  . N DIFROM D ^XMD
  1.  Q
  1.  ;               ** end of vital extract **
  1. VITALS2 ; LOAD SORTED ARRAY INTO ^XTMP
  1.  ;
  1.  N VPT,VPTV
  1.  S VPT=""
  1.  ; ** F  S VPT=$O(PSUVTMP(VPT)) Q:VPT=""  D
  1.  F  S VPT=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT)) Q:VPT=""  D
  1.  . S VPTV=""
  1.  . ; **F  S VPTV=$O(PSUVTMP(VPT,VPTV)) Q:VPTV=""  D
  1.  . F  S VPTV=$O(^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)) Q:VPTV=""  D
  1.  .. ; ** S X=PSUVTMP(VPT,VPT                     ; * LOAD VITAL RECORD
  1.  .. S X=^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",VPT,VPTV)
  1.  .. S LINECNT=LINECNT+1
  1.  .. S LINETOT=LINETOT+1
  1.  .. I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
  1.  .. I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q  ; load
  1.  .. F J=254:-1 Q:$E(X,J)="^"
  1.  .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,J)
  1.  .. S LINECNT=LINECNT+1
  1.  .. S LINETOT=LINETOT+1
  1.  .. S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,J,J+253)
  1.  Q
  1.  ;
  1. IMMUNS ;
  1.  N PSUDATE,ICNT,PSUINUM,PSUIREC,PSUPTPTR,PSUPTREC,PSUSSN,PSUIMPTR
  1.  N PSUIMM,PSUICN,PSURTYPE,PSUIMSG
  1.  ;
  1.  S (PSUMCNT,PSUINUM)=0
  1.  F  S PSUINUM=$O(^AUPNVIMM(PSUINUM)) Q:'PSUINUM  D
  1.  . S PSUIDATE=$P($G(^AUPNVIMM(PSUINUM,12)),"U")  ; ** get IMM date **
  1.  . Q:$P(PSUIDATE,U)=""               ; ** quit if date is null **
  1.  . Q:PSUIDATE<SDATE!(PSUIDATE>EDATE)  ; ** quit if date out of range **
  1.  . S PSUIREC=^AUPNVIMM(PSUINUM,0)    ; ** get IMM record **
  1.  . S PSUPTPTR=$P(PSUIREC,U,2)        ; ** pointer to PAT file **
  1.  . S PSUPTREC=^DPT(PSUPTPTR,0)       ; ** get patient record **
  1.  . S PSUSSN=$P(PSUPTREC,U,9)
  1.  . Q:$E(PSUSSN,1,5)="00000"          ; ** quit if invalid patient **
  1.  . I $P(PSUPTREC,U,21)=1 Q
  1.  . S PSUIMPTR=$P(PSUIREC,U)         ; ** point to IMM file **
  1.  . S PSUIMM=$P(^AUTTIMM(PSUIMPTR,0),U)  ; ** get IMM name **
  1.  . S PSUICN=$$GETICN^MPIF001(PSUPTPTR)  ; ** set ICN **
  1.  . I $P(PSUICN,U)="-1" S PSUICN=""
  1.  . S PSURTYPE="I"                    ; ** set record type **
  1.  . S Z="$"
  1.  . S PSUIMSG=Z_PSUFAC_Z_PSUIDATE_Z_PSURTYPE_Z_PSUSSN_Z_PSUICN_Z_PSUIMM_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z_""_Z
  1.  . S PSUIMSG=$TR(PSUIMSG,"^","'")
  1.  . S X=$TR(PSUIMSG,Z,U)
  1.  . ;   *** load ^XTMP  ***
  1.  . S LINECNT=LINECNT+1
  1.  . S LINETOT=LINETOT+1
  1.  . I LINECNT>LINEMAX S MSGCNT=$G(MSGCNT)+1,LINECNT=1
  1.  . I $L(X)<254 S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=X Q  ; load
  1.  . F K=254:-1 Q:$E(X,K)="^"
  1.  . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)=$E(X,1,K)
  1.  . S LINECNT=LINECNT+1
  1.  . S LINETOT=LINETOT+1
  1.  . S ^XTMP("PSU_"_PSUJOB,"PSUVI",MSGCNT,LINECNT)="*"_$E(X,K,K+253)
  1.  ;                                           *** save message count  ***
  1.  S:$G(MSGCNT) ^XTMP("PSU_"_PSUJOB,"PSUVI","MSGTCNT")=MSGCNT
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUVI","LINECNT")=LINETOT
  1.  Q                                                ; ** quit IMMUNS **
  1.  ;
  1. MAILIT ; MAIL VITAL & IMMUNIZATION EXTRACT MESSAGES
  1.  ;
  1.  D ^PSUVIT2
  1.  Q                         ;  **  quit for MAILIT  **
  1.  ;