PSO7P385.m

PSO7P385 ;BAY PINES-CIOFO/TN - Patch 385 Pre-Post Install routine;4/23/10 5:06pm

 ;;7.0;OUTPATIENT PHARMACY;**385**;DEC 1997;Build 27

 ;

 Q

 ;

POST ;post-install functions are coded here.

 D BMES^XPDUTL("  Starting post-install of PSO*7*385")

 D ELIG,KEYS,MENU,BIN,OPTION

 D BMES^XPDUTL("  Finished post-install of PSO*7*385")

 Q

 ;

ELIG ; populate PSO AUDIT LOG (#52.87), ELIGIBILITY (#18)

 N PSIEN,PSIEN1,DIE,DA,DR,CNTR

 D BMES^XPDUTL("   Updating PSO AUDIT LOG/ELIGIBILITY entries")

 S PSIEN=0,CNTR=0

 F  S PSIEN=$O(^PS(52.87,PSIEN)) Q:'PSIEN  D

 . S PSIEN1=$G(^PS(52.87,PSIEN,1))

 . I $P(PSIEN1,U,3)="" D

 .. S DIE=52.87,DA=PSIEN,DR="18////T" D ^DIE

 .. S CNTR=CNTR+1

 D MES^XPDUTL("    - "_CNTR_" entries updated.")

 D MES^XPDUTL("    - Done with updating PSO AUDIT LOG/ELIGIBILITY entries")

 Q

 ;

KEYS ; Rename the PSO TRICARE Security Keys

 D BMES^XPDUTL("   Renaming PSO TRICARE Security Keys")

 I $$LKUP^XPDKEY("PSO TRICARE") D

 . I $$RENAME^XPDKEY("PSO TRICARE","PSO TRICARE/CHAMPVA") D  Q

 .. D MES^XPDUTL("    - Successfully renamed PSO TRICARE Security Key to PSO TRICARE/CHAMPVA")

 . D MES^XPDUTL("    - Unable to rename PSO TRICARE Security Key")

 ;

 ; Rename the PSO TRICARE MGR Security Keys

 I $$LKUP^XPDKEY("PSO TRICARE MGR") D

 . I $$RENAME^XPDKEY("PSO TRICARE MGR","PSO TRICARE/CHAMPVA MGR") D  Q

 .. D MES^XPDUTL("    - Successfully renamed PSO TRICARE MGR Security Key to PSO TRICARE/CHAMPVA MGR")

 . D MES^XPDUTL("    - Unable to rename PSO TRICARE MGR Security Key")

 D MES^XPDUTL("    - Done with renaming PSO TRICARE Security Keys")

 Q

 ;

MENU ; Remove the cached hidden menu pointers

 N PSORDHM,PSORHA1,XQORM

 D BMES^XPDUTL("   Removing cached hidden menus")

 S PSORDHM=$O(^ORD(101,"B","PSO REJECT DISPLAY HIDDEN MENU",0))

 S XQORM=PSORDHM_";ORD(101,"

 I $D(^XUTL("XQORM",XQORM)) D

 . D MES^XPDUTL("    - Removing cached hidden menu for "_$P(^ORD(101,PSORDHM,0),U))

 . K ^XUTL("XQORM",XQORM)

 ;

 S PSORHA1=$O(^ORD(101,"B","PSO REJECTS HIDDEN ACTIONS #1",0))

 S XQORM=PSORHA1_";ORD(101,"

 I $D(^XUTL("XQORM",XQORM)) D

 . D MES^XPDUTL("    - Removing cached hidden menu for "_$P(^ORD(101,PSORHA1,0),U))

 . K ^XUTL("XQORM",XQORM)

 ;

 S PSORHA1=$O(^ORD(101,"B","PSO PMP HIDDEN ACTIONS MENU #2",0))

 S XQORM=PSORHA1_";ORD(101,"

 I $D(^XUTL("XQORM",XQORM)) D

 . D MES^XPDUTL("    - Removing cached hidden menu for "_$P(^ORD(101,PSORHA1,0),U))

 . K ^XUTL("XQORM",XQORM)

 ;

 S PSORHA1=$O(^ORD(101,"B","PSO HIDDEN ACTIONS #1",0))

 S XQORM=PSORHA1_";ORD(101,"

 I $D(^XUTL("XQORM",XQORM)) D

 . D MES^XPDUTL("    - Removing cached hidden menu for "_$P(^ORD(101,PSORHA1,0),U))

 . K ^XUTL("XQORM",XQORM)

 D MES^XPDUTL("    - Done with removing cached hidden menus")

 Q

 ;

BIN ;Update BIN Number on PRESCRIPTION reject multiple

 ;

 ; Reference to BPSNCPD3 supported by IA 4560

 ;

 N CNT,COB,DAT,DUR,RX,RN,RSPIEN,DA,DR,DIE

 D BMES^XPDUTL("   Updating BIN Numbers")

 S CNT=0

 S DAT=0 F  S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT  D

 . S RX="" F  S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX  D

 .. S RN="" F  S RN=$O(^PSRX("REJDAT",DAT,RX,RN)) Q:'RN  D

 ... I $P($G(^PSRX(RX,"REJ",RN,2)),"^",8)?6N Q

 ... S RSPIEN=$P($G(^PSRX(RX,"REJ",RN,0)),"^",11) I 'RSPIEN Q

 ... S COB=$P($G(^PSRX(RX,"REJ",RN,2)),"^",7) I COB="" S COB=1

 ... K DUR D DURRESP^BPSNCPD3(RSPIEN,.DUR,COB)

 ... I 'DUR(COB,"BIN") Q

 ... S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=RN,DR=29_"////"_DUR(COB,"BIN")

 ... D ^DIE K DA,DR,DIE

 ... S CNT=CNT+1

 D MES^XPDUTL("    - "_CNT_" entries updated")

 D MES^XPDUTL("    - Done with updating BIN Numbers")

 Q

 ;

OPTION ;Update OPTION name

 N OPT,DA,DASAVE,DIE,DR

 D BMES^XPDUTL("   Updating option names")

 S OPT="PSO TRI CVA OVERRIDE REPORT"

 S DA=$O(^DIC(19,"B",OPT,""))

 I DA D  Q

 . D MES^XPDUTL("    - Option name already updated")

 . D MES^XPDUTL("    - Done with updating option names")

 S OPT="PSO TRICARE OVERRIDE REPORT"

 S DA=$O(^DIC(19,"B",OPT,"")),DASAVE=DA

 I 'DA D MES^XPDUTL("      - No IEN found for entry "_OPT) Q

 S DA=DASAVE,DIE="^DIC(19,",DR=".01///PSO TRI CVA OVERRIDE REPORT" D ^DIE

 S DA=DASAVE,DIE="^DIC(19,",DR="1///TRICARE CHAMPVA Bypass/Override Report" D ^DIE

 S DA=DASAVE,DIE="^DIC(19,"_DA_",1,",DA(1)=DA,DA=1,DR=".01///This option will allow a user to create a TRICARE CHAMPVA Bypass/Override report." D ^DIE

 D MES^XPDUTL("    - 1 entry updated")

 D MES^XPDUTL("    - Done with updating option names")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSO7P385   4454     printed  Mar 13, 2025@21:28:42                                                                                                                                                                                                    Page 2

PSO7P385  ;BAY PINES-CIOFO/TN - Patch 385 Pre-Post Install routine;4/23/10 5:06pm

 +1       ;;7.0;OUTPATIENT PHARMACY;**385**;DEC 1997;Build 27

 +2       ;

 +3        QUIT 

 +4       ;

POST      ;post-install functions are coded here.

 +1        DO BMES^XPDUTL("  Starting post-install of PSO*7*385")

 +2        DO ELIG

           DO KEYS

           DO MENU

           DO BIN

           DO OPTION

 +3        DO BMES^XPDUTL("  Finished post-install of PSO*7*385")

 +4        QUIT 

 +5       ;

ELIG      ; populate PSO AUDIT LOG (#52.87), ELIGIBILITY (#18)

 +1        NEW PSIEN,PSIEN1,DIE,DA,DR,CNTR

 +2        DO BMES^XPDUTL("   Updating PSO AUDIT LOG/ELIGIBILITY entries")

 +3        SET PSIEN=0

           SET CNTR=0

 +4        FOR 

               SET PSIEN=$ORDER(^PS(52.87,PSIEN))

               if 'PSIEN

                   QUIT 

               Begin DoDot:1

 +5                SET PSIEN1=$GET(^PS(52.87,PSIEN,1))

 +6                IF $PIECE(PSIEN1,U,3)=""

                       Begin DoDot:2

 +7                        SET DIE=52.87

                           SET DA=PSIEN

                           SET DR="18////T"

                           DO ^DIE

 +8                        SET CNTR=CNTR+1

                       End DoDot:2

               End DoDot:1

 +9        DO MES^XPDUTL("    - "_CNTR_" entries updated.")

 +10       DO MES^XPDUTL("    - Done with updating PSO AUDIT LOG/ELIGIBILITY entries")

 +11       QUIT 

 +12      ;

KEYS      ; Rename the PSO TRICARE Security Keys

 +1        DO BMES^XPDUTL("   Renaming PSO TRICARE Security Keys")

 +2        IF $$LKUP^XPDKEY("PSO TRICARE")

               Begin DoDot:1

 +3                IF $$RENAME^XPDKEY("PSO TRICARE","PSO TRICARE/CHAMPVA")

                       Begin DoDot:2

 +4                        DO MES^XPDUTL("    - Successfully renamed PSO TRICARE Security Key to PSO TRICARE/CHAMPVA")

                       End DoDot:2

                       QUIT 

 +5                DO MES^XPDUTL("    - Unable to rename PSO TRICARE Security Key")

               End DoDot:1

 +6       ;

 +7       ; Rename the PSO TRICARE MGR Security Keys

 +8        IF $$LKUP^XPDKEY("PSO TRICARE MGR")

               Begin DoDot:1

 +9                IF $$RENAME^XPDKEY("PSO TRICARE MGR","PSO TRICARE/CHAMPVA MGR")

                       Begin DoDot:2

 +10                       DO MES^XPDUTL("    - Successfully renamed PSO TRICARE MGR Security Key to PSO TRICARE/CHAMPVA MGR")

                       End DoDot:2

                       QUIT 

 +11               DO MES^XPDUTL("    - Unable to rename PSO TRICARE MGR Security Key")

               End DoDot:1

 +12       DO MES^XPDUTL("    - Done with renaming PSO TRICARE Security Keys")

 +13       QUIT 

 +14      ;

MENU      ; Remove the cached hidden menu pointers

 +1        NEW PSORDHM,PSORHA1,XQORM

 +2        DO BMES^XPDUTL("   Removing cached hidden menus")

 +3        SET PSORDHM=$ORDER(^ORD(101,"B","PSO REJECT DISPLAY HIDDEN MENU",0))

 +4        SET XQORM=PSORDHM_";ORD(101,"

 +5        IF $DATA(^XUTL("XQORM",XQORM))

               Begin DoDot:1

 +6                DO MES^XPDUTL("    - Removing cached hidden menu for "_$PIECE(^ORD(101,PSORDHM,0),U))

 +7                KILL ^XUTL("XQORM",XQORM)

               End DoDot:1

 +8       ;

 +9        SET PSORHA1=$ORDER(^ORD(101,"B","PSO REJECTS HIDDEN ACTIONS #1",0))

 +10       SET XQORM=PSORHA1_";ORD(101,"

 +11       IF $DATA(^XUTL("XQORM",XQORM))

               Begin DoDot:1

 +12               DO MES^XPDUTL("    - Removing cached hidden menu for "_$PIECE(^ORD(101,PSORHA1,0),U))

 +13               KILL ^XUTL("XQORM",XQORM)

               End DoDot:1

 +14      ;

 +15       SET PSORHA1=$ORDER(^ORD(101,"B","PSO PMP HIDDEN ACTIONS MENU #2",0))

 +16       SET XQORM=PSORHA1_";ORD(101,"

 +17       IF $DATA(^XUTL("XQORM",XQORM))

               Begin DoDot:1

 +18               DO MES^XPDUTL("    - Removing cached hidden menu for "_$PIECE(^ORD(101,PSORHA1,0),U))

 +19               KILL ^XUTL("XQORM",XQORM)

               End DoDot:1

 +20      ;

 +21       SET PSORHA1=$ORDER(^ORD(101,"B","PSO HIDDEN ACTIONS #1",0))

 +22       SET XQORM=PSORHA1_";ORD(101,"

 +23       IF $DATA(^XUTL("XQORM",XQORM))

               Begin DoDot:1

 +24               DO MES^XPDUTL("    - Removing cached hidden menu for "_$PIECE(^ORD(101,PSORHA1,0),U))

 +25               KILL ^XUTL("XQORM",XQORM)

               End DoDot:1

 +26       DO MES^XPDUTL("    - Done with removing cached hidden menus")

 +27       QUIT 

 +28      ;

BIN       ;Update BIN Number on PRESCRIPTION reject multiple

 +1       ;

 +2       ; Reference to BPSNCPD3 supported by IA 4560

 +3       ;

 +4        NEW CNT,COB,DAT,DUR,RX,RN,RSPIEN,DA,DR,DIE

 +5        DO BMES^XPDUTL("   Updating BIN Numbers")

 +6        SET CNT=0

 +7        SET DAT=0

           FOR 

               SET DAT=$ORDER(^PSRX("REJDAT",DAT))

               if 'DAT

                   QUIT 

               Begin DoDot:1

 +8                SET RX=""

                   FOR 

                       SET RX=$ORDER(^PSRX("REJDAT",DAT,RX))

                       if 'RX

                           QUIT 

                       Begin DoDot:2

 +9                        SET RN=""

                           FOR 

                               SET RN=$ORDER(^PSRX("REJDAT",DAT,RX,RN))

                               if 'RN

                                   QUIT 

                               Begin DoDot:3

 +10                               IF $PIECE($GET(^PSRX(RX,"REJ",RN,2)),"^",8)?6N

                                       QUIT 

 +11                               SET RSPIEN=$PIECE($GET(^PSRX(RX,"REJ",RN,0)),"^",11)

                                   IF 'RSPIEN

                                       QUIT 

 +12                               SET COB=$PIECE($GET(^PSRX(RX,"REJ",RN,2)),"^",7)

                                   IF COB=""

                                       SET COB=1

 +13                               KILL DUR

                                   DO DURRESP^BPSNCPD3(RSPIEN,.DUR,COB)

 +14                               IF 'DUR(COB,"BIN")

                                       QUIT 

 +15                               SET DIE="^PSRX("_RX_",""REJ"","

                                   SET DA(1)=RX

                                   SET DA=RN

                                   SET DR=29_"////"_DUR(COB,"BIN")

 +16                               DO ^DIE

                                   KILL DA,DR,DIE

 +17                               SET CNT=CNT+1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18       DO MES^XPDUTL("    - "_CNT_" entries updated")

 +19       DO MES^XPDUTL("    - Done with updating BIN Numbers")

 +20       QUIT 

 +21      ;

OPTION    ;Update OPTION name

 +1        NEW OPT,DA,DASAVE,DIE,DR

 +2        DO BMES^XPDUTL("   Updating option names")

 +3        SET OPT="PSO TRI CVA OVERRIDE REPORT"

 +4        SET DA=$ORDER(^DIC(19,"B",OPT,""))

 +5        IF DA

               Begin DoDot:1

 +6                DO MES^XPDUTL("    - Option name already updated")

 +7                DO MES^XPDUTL("    - Done with updating option names")

               End DoDot:1

               QUIT 

 +8        SET OPT="PSO TRICARE OVERRIDE REPORT"

 +9        SET DA=$ORDER(^DIC(19,"B",OPT,""))

           SET DASAVE=DA

 +10       IF 'DA

               DO MES^XPDUTL("      - No IEN found for entry "_OPT)

               QUIT 

 +11       SET DA=DASAVE

           SET DIE="^DIC(19,"

           SET DR=".01///PSO TRI CVA OVERRIDE REPORT"

           DO ^DIE

 +12       SET DA=DASAVE

           SET DIE="^DIC(19,"

           SET DR="1///TRICARE CHAMPVA Bypass/Override Report"

           DO ^DIE

 +13       SET DA=DASAVE

           SET DIE="^DIC(19,"_DA_",1,"

           SET DA(1)=DA

           SET DA=1

           SET DR=".01///This option will allow a user to create a TRICARE CHAMPVA Bypass/Override report."

           DO ^DIE

 +14       DO MES^XPDUTL("    - 1 entry updated")

 +15       DO MES^XPDUTL("    - Done with updating option names")

 +16       QUIT