PSUTL1 ;BIR/CFL - Subroutines for PBMS Modules ;25 AUG 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;Reference to file #2 supported by DBIA #3301
SECTN ;Service/Sections Array
S PSECT("AMBULATORY CARE")="AMB"
S PSECT("ANESTHESIOLOGY")="ANES"
S PSECT("CARDIOLOGY")="CV"
S PSECT("CLINICAL PHARMACY")="CPHAR"
S PSECT("DENTAL")="DDS"
S PSECT("INTERMEDIATE MEDICINE")="IM"
S PSECT("MEDICINE")="MED"
S PSECT("NEUROLOGY")="NEUR"
S PSECT("NUCLEAR MEDICINE")="NUM"
S PSECT("NURSING")="RN"
S PSECT("ORTHOPEDICS")="ORTHO"
S PSECT("PSYCHIATRY")="PSY"
S PSECT("RADIOLOGY")="RAD"
S PSECT("SURGERY")="SUR"
S PSECT("UROLOGY")="U"
SECTNQ Q
;
PURGE ; remove outdated PSU namespace entries in ^XTMP
N PSUI,PSUPDT,PSUCDT
D NOW^%DTC
S PSUCDT=X
S PSUI="PSU"
F S PSUI=$O(^XTMP(PSUI)) Q:$E(PSUI,1,3)'="PSU" D
.S PSUPDT=$P($G(^XTMP(PSUI,0)),"^",1)
.I PSUPDT="" K ^XTMP(PSUI) Q
.I PSUPDT<PSUCDT K ^XTMP(PSUI) Q
PURGEQ Q ; purge complete
;
XMY ;EP Setup Mail Groups
; PSUXMYH() Mail Group for Hines Message and message to self/PBM group
; PSUXMYS1() Mail Group for Summary 1 & No Data Messages
; PSUXMYS2() Mail Group for Summary 2 Messages
;S PSUPBMG=^XTMP("PSU_"_PSUJOB,"PSUPBMG")
;
Q:$D(^XTMP("PSU_"_$G(PSUJOB),"PSUFLAG3"))
;
; Hines Group
I $G(PSUMASF) D
.S PSUXMYH("G.PSU PBM@CMOP-NAT.DOMAIN.EXT")=""
I $G(PSUPBMG) S PSUXMYH("G.PSU PBM")="" ;local PBM mail group
I $G(PSUDUZ) S PSUXMYH(PSUDUZ)="" ;self
;
; Summary 1 Group and NO DATA message
S PSUXMYS1("G.PSU PBM")=""
I $G(PSUDUZ) S PSUXMYS1(PSUDUZ)=""
;
; Summary 2 Group
S PSUXMYS2("G.PSU PBM")=""
I $G(PSUDUZ) S PSUXMYS2(PSUDUZ)=""
XMYQ Q
;EXIT
TESTPAT(DFN) ;EP SCREEN AGAINST TEST PATIENTS (RETURN=1 IF TEST)
Q:'DFN 0
D PID^VADPT
I VA("PID")["000-00" Q 1
Q $$VALI^PSUTL(2,DFN,.6)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUTL1 1852 printed Nov 22, 2024@17:38:37 Page 2
PSUTL1 ;BIR/CFL - Subroutines for PBMS Modules ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;Reference to file #2 supported by DBIA #3301
SECTN ;Service/Sections Array
+1 SET PSECT("AMBULATORY CARE")="AMB"
+2 SET PSECT("ANESTHESIOLOGY")="ANES"
+3 SET PSECT("CARDIOLOGY")="CV"
+4 SET PSECT("CLINICAL PHARMACY")="CPHAR"
+5 SET PSECT("DENTAL")="DDS"
+6 SET PSECT("INTERMEDIATE MEDICINE")="IM"
+7 SET PSECT("MEDICINE")="MED"
+8 SET PSECT("NEUROLOGY")="NEUR"
+9 SET PSECT("NUCLEAR MEDICINE")="NUM"
+10 SET PSECT("NURSING")="RN"
+11 SET PSECT("ORTHOPEDICS")="ORTHO"
+12 SET PSECT("PSYCHIATRY")="PSY"
+13 SET PSECT("RADIOLOGY")="RAD"
+14 SET PSECT("SURGERY")="SUR"
+15 SET PSECT("UROLOGY")="U"
SECTNQ QUIT
+1 ;
PURGE ; remove outdated PSU namespace entries in ^XTMP
+1 NEW PSUI,PSUPDT,PSUCDT
+2 DO NOW^%DTC
+3 SET PSUCDT=X
+4 SET PSUI="PSU"
+5 FOR
SET PSUI=$ORDER(^XTMP(PSUI))
if $EXTRACT(PSUI,1,3)'="PSU"
QUIT
Begin DoDot:1
+6 SET PSUPDT=$PIECE($GET(^XTMP(PSUI,0)),"^",1)
+7 IF PSUPDT=""
KILL ^XTMP(PSUI)
QUIT
+8 IF PSUPDT<PSUCDT
KILL ^XTMP(PSUI)
QUIT
End DoDot:1
PURGEQ ; purge complete
QUIT
+1 ;
XMY ;EP Setup Mail Groups
+1 ; PSUXMYH() Mail Group for Hines Message and message to self/PBM group
+2 ; PSUXMYS1() Mail Group for Summary 1 & No Data Messages
+3 ; PSUXMYS2() Mail Group for Summary 2 Messages
+4 ;S PSUPBMG=^XTMP("PSU_"_PSUJOB,"PSUPBMG")
+5 ;
+6 if $DATA(^XTMP("PSU_"_$GET(PSUJOB),"PSUFLAG3"))
QUIT
+7 ;
+8 ; Hines Group
+9 IF $GET(PSUMASF)
Begin DoDot:1
+10 SET PSUXMYH("G.PSU PBM@CMOP-NAT.DOMAIN.EXT")=""
End DoDot:1
+11 ;local PBM mail group
IF $GET(PSUPBMG)
SET PSUXMYH("G.PSU PBM")=""
+12 ;self
IF $GET(PSUDUZ)
SET PSUXMYH(PSUDUZ)=""
+13 ;
+14 ; Summary 1 Group and NO DATA message
+15 SET PSUXMYS1("G.PSU PBM")=""
+16 IF $GET(PSUDUZ)
SET PSUXMYS1(PSUDUZ)=""
+17 ;
+18 ; Summary 2 Group
+19 SET PSUXMYS2("G.PSU PBM")=""
+20 IF $GET(PSUDUZ)
SET PSUXMYS2(PSUDUZ)=""
XMYQ QUIT
+1 ;EXIT
TESTPAT(DFN) ;EP SCREEN AGAINST TEST PATIENTS (RETURN=1 IF TEST)
+1 if 'DFN
QUIT 0
+2 DO PID^VADPT
+3 IF VA("PID")["000-00"
QUIT 1
+4 QUIT $$VALI^PSUTL(2,DFN,.6)
+5 ;
