- 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 Feb 18, 2025@23:54: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 ;