source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUTL1.m@ 642

Last change on this file since 642 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PSUTL1 ;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
4SECTN ;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"
20SECTNQ Q
21 ;
22PURGE ; 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
31PURGEQ Q ; purge complete
32 ;
33XMY ;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)=""
54XMYQ Q
55 ;EXIT
56TESTPAT(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 ;
Note: See TracBrowser for help on using the repository browser.