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
;
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 ---[H[J[2J[HPSO7P385 4454 printed Dec 13, 2024@02:23:49 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 ;
+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
