Changeset 636 for FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCP.m (modified) (4 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM1.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM4.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL1.m (modified) (3 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUMAP0.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOPAM.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUPR2.m (modified) (3 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSURT1.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM1.m (modified) (2 diffs)
• PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUVIT1.m (modified) (5 diffs)

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCP.m

@@ -1 @@
-PSUCP ;BIR/TJH,PDW - PBM CONTROL POINT ; 06/08/07
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+PSUCP ;BIR/TJH,PDW - PBM CONTROL POINT ;25 AUG 1998
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ; Reference to File #4    supported by DBIA 10090
  ; Reference to File #4.3  supported by DBIA 10091
  ; Reference to File #40.8 supported by DBIA 2438
  ; Reference to File #59.7 supported by DBIA 2854
- ; move CLEANUP^PSUHL from PSURT1, delete calls to PSUCP3 (PSU*4*12)
 MANUAL ; entry point for manual option
  S PSUALERT=0 D MANUAL^PSUALERT
@@ -18 +17 @@
  .S DIR("A")="Do you wish to continue"
  .D ^DIR
- D CLEANUP^PSUHL
+ D ^PSUCP3
  S PSUJOB=$J_"_"_$P($H,",",2)
  S ^XTMP("PSUMANL")=""
@@ -37 +36 @@
  S PSUALERT=0 D AUTO^PSUALERT
  I PSUALERT K PSUALERT Q
- I $D(^XTMP("PSU","RUNNING")) D  Q
+ I $G(^XTMP("PSU","RUNNING")) D  Q
  .S XQA(DUZ)="",XQA("G.PSU PBM")="",XQMSG="An ERROR has occurred. Please contact IRM for assistance."
  .S XQAID="PSU",XQAFLG="D" D SETUP^XQALERT
- D CLEANUP^PSUHL
+ D ^PSUCP3         ;Clear trash globals
  S PSUJOB=$J_"_"_$P($H,",",2)
  S ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")=""   ;flag for mail patient summary reports
@@ -67 +66 @@
  D ^PSUDBQUE
  K PSUALERT,XQA,XQAID,XQAFLG,XQA,ZTSK
-AUTOQ Q  ; exit from AUTO
+AUTOQ D EXIT Q  ; exit from AUTO
  ;
 RUN ; run each selected module

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM1.m

@@ -1 +1 @@
 PSUDEM1 ;BIR/DAM - Patient Demographics Extract ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ;DBIA's
@@ -38 +38 @@
  ;information ONLY on new or updated patient.
  ;
- ; *** PSU*4.0*12 - BAJ -- added QUIT if NULL
- F  S PSUSDT=$O(^PSUDEM("B",PSUSDT)) Q:PSUSDT=""  Q:PSUSDT>PSUEDT  D
+ F  S PSUSDT=$O(^PSUDEM("B",PSUSDT)) Q:PSUSDT>PSUEDT  D
  . S I=""
  . S I=$O(^PSUDEM("B",PSUSDT,I)) Q:I=""

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM4.m

@@ -1 @@
-PSUDEM4 ;BIR/DAM - Provider Extract ; 4/26/07 4:38pm
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**8,12**;MARCH, 2005;Build 19
+PSUDEM4 ;BIR/DAM - Provider Extract ; 7/21/06 2:27pm
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;**8**;MARCH, 2005
  ;
  ;DBIA'S
@@ -102 +102 @@
 CLASS ;Find provider class
  ;
- I '$D(PSUCLP) S $P(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIEN),U,5)="" Q
+ I '$D(PSUCLP) S $P(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIEN),U,5)=""
  I PSUCLP="" S $P(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIEN),U,5)=""
  I PSUCLP'="" D
- .N PSUA
- .S PSUA=$P($G(^DIC(7,PSUCLP,0)),U,2)
- .I PSUA']"" S PSUA=$P($G(^DIC(7,PSUCLP,0)),U,1)
- .S $P(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIEN),U,5)=PSUA  ;Prov class
- .K PSUA
+ .S $P(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIEN),U,5)=$P($G(^DIC(7,PSUCLP,0)),U,2)  ;Prov class
  Q
  ;

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSULRHL1.m

@@ -1 @@
-PSULRHL1 ;HCIOFO/BH/RDC - Process real time HL7 Lab messages ; 8/1/07 11:26am
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3,11**;MARCH, 2005;Build 8
+PSULRHL1 ;HCIOFO/BH/RDC - Process real time HL7 Lab messages ; 5/15/04 3:10pm
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;**3**;MARCH, 2005
  ;
  ; DBIA 3565 to subscribe to the LR7O ALL EVSEND RESULTS protocol
@@ -156 +156 @@
  S LABS=$P(REC,PSUHLFS,4)
  S LR60=$P(LABS,"^",4)
- I LR60']"" Q
  S LRDN=$G(^LAB(60,LR60,0))
  S LRDN=$P($P(LRDN,"^",5),";",2)   ;  DBIA 91 for data name
@@ -162 +161 @@
  ; Make the call to LRRPU to get the LOINC code for this test
  ;
- I LRDN']"" Q
  S RES=$$TSTRES^LRRPU(LRDFN,LRSS,LRIDT,LRDN,LR60,1)
  ;

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUMAP0.m

@@ -1 @@
-PSUMAP0 ;BHM/PDW-MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 4/12/07 2:12pm
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+PSUMAP0 ;BHM/PDW-MAP OAU,NAOU,DA LOCATION TO DIVISION/OUTPATIENT SITES ; 9SEP2003
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ;DBIA's
@@ -51 +51 @@
  ..K PJJ,XBEG,XEND
  .S PSUMOD(X1)=""
- ; modified to fix <UNDEFINED> PSU*3*12 BAJ
- S X="",ERC=0 F  S X=$O(PSUMOD(X)) Q:X=""  I '$D(PSUA(X)) S ERC=1 Q
+ S (X,ERC)=0 F  S X=$O(PSUMOD(X)) Q:X=""  I '$D(PSUA(X)) S ERC=1 Q
  I ERC W !!,"<INVALID CHOICE - ",X,", TRY AGAIN>",$C(7) G MODP
  I '$D(PSUMOD) W !!,"No choices were made." K DIR S DIR(0)="E",DIR("A")="EXITING" D ^DIR G EXIT

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOPAM.m

@@ -1 @@
-PSUOPAM ;BIR/DAM - PSU PBM Outpatient AMIS Pharmacy Data Collection; March 2004 ; 1/11/08 11:46am
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**13**;MARCH, 2005;Build 3
+PSUOPAM ;BIR/DAM - PSU PBM Outpatient AMIS Pharmacy Data Collection; March 2004
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ;DBIA's
@@ -20 +20 @@
 CO ;Copay status: found in file (#52), field (#105)
  ;
- ;PSU*4*13 Corrected to show the COPAY.
- S PSUCO=$P($G(^TMP("PSOR",$J,PSURXIEN,"IB")),U,1)
+ S PSUCO=$P($G(^TMP("PSOR",$J,PSURXIEN,"IB",0)),U,1)
  I $G(PSUCO) S PSUCOPAY="Y"
  I '$G(PSUCO) S PSUCOPAY="N"

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUPR2.m

@@ -1 @@
-PSUPR2 ;BIR/PDW - Procurement extract from file 58.811 ; 4/1/08 4:09pm
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**13**;MARCH, 2005;Build 3
+PSUPR2 ;BIR/PDW - Procurement extract from file 58.811 ;20 AUG 1999
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;DBIAs
  ; Reference to file #58.811 supported by DBIA 2521
@@ -127 +127 @@
  I '$D(PSUADJ),'PSUIT(9999) S PSUIT(9999)="" ; per Lina
  ;
- ;PSU*4*13 Comment out To prevent XINDEX from complaining about
- ; ^PSUPR7 (CoreFLS remnance)
  ;Create "RECORDS" global for CoreFLS data
- ;I $D(PSUFLSFG) S PSUA="" D
- ;.F  S PSUA=$O(^XTMP(PSUPRSUB,"PSUFLS",PSUA)) Q:PSUA=""  D SIMPL^PSUPR7
+ I $D(PSUFLSFG) S PSUA="" D
+ .F  S PSUA=$O(^XTMP(PSUPRSUB,"PSUFLS",PSUA)) Q:PSUA=""  D SIMPL^PSUPR7
  ;
  ;   Construct record and store into ^XTMP(PSUPRSUB,"RECORDS",PSUDIV,LC)
@@ -231 +229 @@
  .S PSUDA=0
  .F  S PSUDA=$O(MAPLOC(PSUDA)) Q:PSUDA=""  D
- ..;PSU*4*13 Correct Problm DA Pharm Report
- ..I $G(MAPLOC(PSUDA,.02))'="" K DAPH(PSUDA)
- ..I $G(MAPLOC(PSUDA,.03))'="" K DAPH(PSUDA)
+ ..I $G(MAPLOC(PSUDA,.02))'="" K NAOU(PSUDA)
+ ..I $G(MAPLOC(PSUDA,.03))'="" K NAOU(PSUDA)
  M ^XTMP(PSUARSUB,"DAPH")=DAPH      ;only unmapped DA PHARM locations.
  Q

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSURT1.m

@@ -1 @@
-PSURT1 ;BIR/RDC - PATIENT DEMOGRAPHIC RETRANSMITION; APR 2, 2007 ; 4/2/07 11:01am
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+PSURT1 ;BIR/RDC - PATIENT DEMOGRAPHIC RETRANSMITION; 31 MAR 2004
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ; THIS PROGRAM WILL ALLOW THE RETRANSMITION OF THE PATIENT
@@ -9 +9 @@
  NEW P,SDT,EDT,WHEN,NOGOOD,TMON,RMONTH,PMON,SMON,EMON,RTYPE,SRANGE,ERANGE
  S P=""
- ; move call to CLEANUP^PSUHL to routine PSUCP (PSU*4*12) 
+ D CLEANUP^PSUHL
  S SDT=$O(^PSUDEM("B",P))
  I 'SDT W !,"NO DATA AVAILABLE - NOTIFY YOUR SUPERVISOR" Q

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM1.m

@@ -1 @@
-PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 2/23/07 2:18pm
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**12**;MARCH, 2005;Build 19
+PSUSUM1 ;BIR/DAM - Summary Report for Provider Extract ; 20 DEC 2001
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ; No DBIA's required.
@@ -55 +55 @@
  S PSUIP=0
  F  S PSUIP=$O(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)) Q:PSUIP=""  Q:PSUIP["U"  D
- .I $P($G(^VA(200,PSUIP,"PS")),"^",6)=4 Q  ; Exclude if the provider type is "FEE BASIS" (PSU*4*12)
  .S PSUSSN3=$E($P($G(^XTMP("PSU_"_PSUJOB,"PSUPROV",PSUIP)),U,3),6,9)
  .I PSUSSN3="" S PSUSSN3="????",PSUMIS="SSN" D NAM             ;No SSN

FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUVIT1.m

@@ -1 @@
-PSUVIT1 ;BIR/RDC - VITALS & IMMUNIZATION EXTRACT; 24 DEC 2003 ; 10/9/07 7:03am
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;**11**;MARCH, 2005;Build 8
+PSUVIT1 ;BIR/RDC - VITALS & IMMUNIZATION EXTRACT; 24 DEC 2003
+ ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  ;
  ;DBIA's
@@ -72 +72 @@
  N PSURTYPE,PSUSSN,PSUICN,PSUVTYPE,PSUVRATE,PSUVUNIT
  N Z,QQ,PSUVQ1,PSUVQ2,PSUVQ3,PSUVQ4,PSUVLIST,PSUVMSG
- N PSULN,PSUTXT
  ;
  S PSUVLIST="""BLOOD PRESSURE"",""HEIGHT"",""WEIGHT"",""PAIN"",""PULSE"",""PULSE OXIMETRY"""
@@ -78 +77 @@
  ;                          ** Loop through date index for valid dates **
  S PSUDATE=SDATE
- ;PSU*4*11 Added null ptr notification.
- S PSUTXT(1)="The following IEN(s) have a null pointer in the PATIENT (#2) field of"
- S PSUTXT(2)="the GMRV VITAL MEASUREMENT file (#120.5).  Please notify your IRM and"
- S PSUTXT(3)="submit a remedy ticket for help in evaluating the record."
- S PSULN=3
  F  S PSUDATE=$O(^GMR(120.5,"B",PSUDATE)) Q:PSUDATE>EDATE!('PSUDATE)  D
  . S PSUV=""                      ; ** loop thru vitals for each date **
@@ -89 +83 @@
  .. S PSUVREC=$G(^GMR(120.5,PSUV,0)) Q:'PSUVREC
  .. S PSUPTPTR=$P(PSUVREC,U,2)    ; ** point to PATIENT **
- .. I PSUPTPTR="" D  Q            ; ** quit if no patient pointer **
- ... S PSULN=PSULN+1
- ... S PSUTXT(PSULN)=PSUV
  .. Q:$G(^DPT(PSUPTPTR,0))=""     ; ** quit if no patient record **
  .. S PSUPTREC=^DPT(PSUPTPTR,0)   ; ** get patient record **
@@ -123 +114 @@
  .. ; ** S PSUVTMP(PSUSSN,PSUVTYPE)=PSUVMSG
  .. S ^XTMP("PSU_"_PSUJOB,"PSUVI","TMP",PSUSSN,PSUVTYPE)=PSUVMSG
- ;PSU*4*11 Send null ptr notifications to PBM group.
- I PSULN>3 D
- . S XMTEXT="PSUTXT(",XMY("G.PSU PBM")=""
- . S XMSUB="** PBM vitals extract detected null patient pointer(s) **"
- . S XMDUZ="Pharmacy Benefits Management Package"
- . N DIFROM D ^XMD
  Q
  ;               ** end of vital extract **