PSUTL1.m

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 ---PSUTL1   1852     printed  Apr 09, 2024@21:29:59                                                                                                                                                                                                      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       ;