| 1 | PSUTL1 ;BIR/CFL - Subroutines for PBMS Modules ;25 AUG 1998
 | 
|---|
| 2 |  ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
 | 
|---|
| 3 |  ;Reference to file #2 supported by DBIA #3301
 | 
|---|
| 4 | SECTN ;Service/Sections Array
 | 
|---|
| 5 |  S PSECT("AMBULATORY CARE")="AMB"
 | 
|---|
| 6 |  S PSECT("ANESTHESIOLOGY")="ANES"
 | 
|---|
| 7 |  S PSECT("CARDIOLOGY")="CV"
 | 
|---|
| 8 |  S PSECT("CLINICAL PHARMACY")="CPHAR"
 | 
|---|
| 9 |  S PSECT("DENTAL")="DDS"
 | 
|---|
| 10 |  S PSECT("INTERMEDIATE MEDICINE")="IM"
 | 
|---|
| 11 |  S PSECT("MEDICINE")="MED"
 | 
|---|
| 12 |  S PSECT("NEUROLOGY")="NEUR"
 | 
|---|
| 13 |  S PSECT("NUCLEAR MEDICINE")="NUM"
 | 
|---|
| 14 |  S PSECT("NURSING")="RN"
 | 
|---|
| 15 |  S PSECT("ORTHOPEDICS")="ORTHO"
 | 
|---|
| 16 |  S PSECT("PSYCHIATRY")="PSY"
 | 
|---|
| 17 |  S PSECT("RADIOLOGY")="RAD"
 | 
|---|
| 18 |  S PSECT("SURGERY")="SUR"
 | 
|---|
| 19 |  S PSECT("UROLOGY")="U"
 | 
|---|
| 20 | SECTNQ Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | PURGE ; remove outdated PSU namespace entries in ^XTMP
 | 
|---|
| 23 |  N PSUI,PSUPDT,PSUCDT
 | 
|---|
| 24 |  D NOW^%DTC
 | 
|---|
| 25 |  S PSUCDT=X
 | 
|---|
| 26 |  S PSUI="PSU"
 | 
|---|
| 27 |  F  S PSUI=$O(^XTMP(PSUI)) Q:$E(PSUI,1,3)'="PSU"  D
 | 
|---|
| 28 |  .S PSUPDT=$P($G(^XTMP(PSUI,0)),"^",1)
 | 
|---|
| 29 |  .I PSUPDT="" K ^XTMP(PSUI) Q
 | 
|---|
| 30 |  .I PSUPDT<PSUCDT K ^XTMP(PSUI) Q
 | 
|---|
| 31 | PURGEQ Q  ; purge complete
 | 
|---|
| 32 |  ;
 | 
|---|
| 33 | XMY ;EP Setup Mail Groups
 | 
|---|
| 34 |  ; PSUXMYH()  Mail Group for Hines Message and message to self/PBM group
 | 
|---|
| 35 |  ; PSUXMYS1() Mail Group for Summary 1 & No Data Messages
 | 
|---|
| 36 |  ; PSUXMYS2() Mail Group for Summary 2 Messages
 | 
|---|
| 37 |  ;S PSUPBMG=^XTMP("PSU_"_PSUJOB,"PSUPBMG")
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 |  Q:$D(^XTMP("PSU_"_$G(PSUJOB),"PSUFLAG3"))
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  ; Hines Group
 | 
|---|
| 42 |  I $G(PSUMASF) D
 | 
|---|
| 43 |  .S PSUXMYH("G.PSU PBM@CMOP-NAT.MED.VA.GOV")=""
 | 
|---|
| 44 |  I $G(PSUPBMG) S PSUXMYH("G.PSU PBM")=""   ;local PBM mail group
 | 
|---|
| 45 |  I $G(PSUDUZ) S PSUXMYH(PSUDUZ)=""         ;self
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  ; Summary 1 Group and NO DATA message
 | 
|---|
| 48 |  S PSUXMYS1("G.PSU PBM")=""
 | 
|---|
| 49 |  I $G(PSUDUZ) S PSUXMYS1(PSUDUZ)=""
 | 
|---|
| 50 |  ;
 | 
|---|
| 51 |  ; Summary 2 Group
 | 
|---|
| 52 |  S PSUXMYS2("G.PSU PBM")=""
 | 
|---|
| 53 |  I $G(PSUDUZ) S PSUXMYS2(PSUDUZ)=""
 | 
|---|
| 54 | XMYQ Q
 | 
|---|
| 55 |  ;EXIT
 | 
|---|
| 56 | TESTPAT(DFN) ;EP SCREEN AGAINST TEST PATIENTS (RETURN=1 IF TEST)
 | 
|---|
| 57 |  Q:'DFN 0
 | 
|---|
| 58 |  D PID^VADPT
 | 
|---|
| 59 |  I VA("PID")["000-00" Q 1
 | 
|---|
| 60 |  Q $$VALI^PSUTL(2,DFN,.6)
 | 
|---|
| 61 |  ;
 | 
|---|