PSS1P201 ;BP/CMF - PATCH PSS*1*201 Pre/Post-Init Rtn ;09/13/2016
;;1.0;PHARMACY DATA MANAGEMENT;**201**;9/30/97;Build 25
;
ENV ;environment check
S XPDABORT=""
;D PRODCHK(.XPDABORT) I XPDABORT=2 Q restriction removed after sprint 3
D PROGCHK(.XPDABORT)
I XPDABORT="" K XPDABORT
Q
;
PRODCHK(XPDABORT) ;checks for test/production account
;
I $$PROD^XUPROD DO
. D BMES^XPDUTL("******")
. D MES^XPDUTL("PSS*1*201 is not yet ready for production accounts.")
. D MES^XPDUTL("Installation aborted.")
. D MES^XPDUTL("******")
. S XPDABORT=2
Q
;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
;
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
. D BMES^XPDUTL("******")
. D MES^XPDUTL("Your programming variables are not set up properly.")
. D MES^XPDUTL("Installation aborted.")
. D MES^XPDUTL("******")
. S XPDABORT=2
Q
;
POST ;;
D APSP ; add entries to Intervention Type file
D DOSEUNIT ; edit entry 40
Q
;;
APSP ;;
N FDA,FDERROR,LIST,LISTERR,I,IEN
D BMES^XPDUTL("Adding entries to APSP Intervention Type file")
D FIND^DIC(9009032.3,"","","X","MAX DAILY DOSE","","","","","LIST","LISTERR")
D:$P(LIST("DILIST",0),U,1)=0
.S FDA(1,9009032.3,"+1,",.01)="MAX DAILY DOSE"
.D UPDATE^DIE("E","FDA(1)","","FDERROR")
.I '$D(FDERROR) D MES^XPDUTL("MAX DAILY DOSE added.")
.Q
D:$P(LIST("DILIST",0),U,1)>1
.S I=1
.F S I=$O(LIST("DILIST",2,I)) Q:I="" D
..S IEN=LIST("DILIST",2,I)
..D KILLAPSP(IEN)
..Q
K FDA,FDERROR,LIST,LISTERR,I,IEN
D FIND^DIC(9009032.3,"","","X","MAX SINGLE DOSE & MAX DAILY DOSE","","","","","LIST","LISTERR")
D:$P(LIST("DILIST",0),U,1)=0
.S FDA(1,9009032.3,"+1,",.01)="MAX SINGLE DOSE & MAX DAILY DOSE"
.D UPDATE^DIE("E","FDA(1)","","FDERROR")
.I '$D(FDERROR) D MES^XPDUTL("MAX SINGLE DOSE & MAX DAILY DOSE added.")
.Q
D:$P(LIST("DILIST",0),U,1)>1
.S I=1
.F S I=$O(LIST("DILIST",2,I)) Q:I="" D
..S IEN=LIST("DILIST",2,I)
..D KILLAPSP(IEN)
..Q
K FDA,FDERROR,LIST,LISTERR,I,IEN
Q
;;
KILLAPSP(IEN) ;; remove duplicates
N DIK,DA
S DIK="^APSPQA(32.3,",DA=IEN D ^DIK
Q
;;
DOSEUNIT ;; change file 51.24 entry 40 .01 value, so KIDS can update the correct entry
N XUMF,DA,DIE,DR
Q:$$FIND1^DIC(51.24,"","MX","SUPPOSITORY(IES)")>0
S DA=+$$FIND1^DIC(51.24,"","MX","SUPPOSITOR(IES)")
Q:DA<1
S XUMF=1,DR=".01////SUPPOSITORY(IES)",DIE=51.24 D ^DIE
D:$$FIND1^DIC(51.24,"","MX","SUPPOSITORY(IES)")>0 BMES^XPDUTL("Dose Unit Entry Modified")
Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS1P201 2515 printed Apr 09, 2024@21:33:18 Page 2
PSS1P201 ;BP/CMF - PATCH PSS*1*201 Pre/Post-Init Rtn ;09/13/2016
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**201**;9/30/97;Build 25
+2 ;
ENV ;environment check
+1 SET XPDABORT=""
+2 ;D PRODCHK(.XPDABORT) I XPDABORT=2 Q restriction removed after sprint 3
+3 DO PROGCHK(.XPDABORT)
+4 IF XPDABORT=""
KILL XPDABORT
+5 QUIT
+6 ;
PRODCHK(XPDABORT) ;checks for test/production account
+1 ;
+2 IF $$PROD^XUPROD
Begin DoDot:1
+3 DO BMES^XPDUTL("******")
+4 DO MES^XPDUTL("PSS*1*201 is not yet ready for production accounts.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("******")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
PROGCHK(XPDABORT) ;checks for necessary programmer variables
+1 ;
+2 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+3 DO BMES^XPDUTL("******")
+4 DO MES^XPDUTL("Your programming variables are not set up properly.")
+5 DO MES^XPDUTL("Installation aborted.")
+6 DO MES^XPDUTL("******")
+7 SET XPDABORT=2
End DoDot:1
+8 QUIT
+9 ;
POST ;;
+1 ; add entries to Intervention Type file
DO APSP
+2 ; edit entry 40
DO DOSEUNIT
+3 QUIT
+4 ;;
APSP ;;
+1 NEW FDA,FDERROR,LIST,LISTERR,I,IEN
+2 DO BMES^XPDUTL("Adding entries to APSP Intervention Type file")
+3 DO FIND^DIC(9009032.3,"","","X","MAX DAILY DOSE","","","","","LIST","LISTERR")
+4 if $PIECE(LIST("DILIST",0),U,1)=0
Begin DoDot:1
+5 SET FDA(1,9009032.3,"+1,",.01)="MAX DAILY DOSE"
+6 DO UPDATE^DIE("E","FDA(1)","","FDERROR")
+7 IF '$DATA(FDERROR)
DO MES^XPDUTL("MAX DAILY DOSE added.")
+8 QUIT
End DoDot:1
+9 if $PIECE(LIST("DILIST",0),U,1)>1
Begin DoDot:1
+10 SET I=1
+11 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if I=""
QUIT
Begin DoDot:2
+12 SET IEN=LIST("DILIST",2,I)
+13 DO KILLAPSP(IEN)
+14 QUIT
End DoDot:2
End DoDot:1
+15 KILL FDA,FDERROR,LIST,LISTERR,I,IEN
+16 DO FIND^DIC(9009032.3,"","","X","MAX SINGLE DOSE & MAX DAILY DOSE","","","","","LIST","LISTERR")
+17 if $PIECE(LIST("DILIST",0),U,1)=0
Begin DoDot:1
+18 SET FDA(1,9009032.3,"+1,",.01)="MAX SINGLE DOSE & MAX DAILY DOSE"
+19 DO UPDATE^DIE("E","FDA(1)","","FDERROR")
+20 IF '$DATA(FDERROR)
DO MES^XPDUTL("MAX SINGLE DOSE & MAX DAILY DOSE added.")
+21 QUIT
End DoDot:1
+22 if $PIECE(LIST("DILIST",0),U,1)>1
Begin DoDot:1
+23 SET I=1
+24 FOR
SET I=$ORDER(LIST("DILIST",2,I))
if I=""
QUIT
Begin DoDot:2
+25 SET IEN=LIST("DILIST",2,I)
+26 DO KILLAPSP(IEN)
+27 QUIT
End DoDot:2
End DoDot:1
+28 KILL FDA,FDERROR,LIST,LISTERR,I,IEN
+29 QUIT
+30 ;;
KILLAPSP(IEN) ;; remove duplicates
+1 NEW DIK,DA
+2 SET DIK="^APSPQA(32.3,"
SET DA=IEN
DO ^DIK
+3 QUIT
+4 ;;
DOSEUNIT ;; change file 51.24 entry 40 .01 value, so KIDS can update the correct entry
+1 NEW XUMF,DA,DIE,DR
+2 if $$FIND1^DIC(51.24,"","MX","SUPPOSITORY(IES)")>0
QUIT
+3 SET DA=+$$FIND1^DIC(51.24,"","MX","SUPPOSITOR(IES)")
+4 if DA<1
QUIT
+5 SET XUMF=1
SET DR=".01////SUPPOSITORY(IES)"
SET DIE=51.24
DO ^DIE
+6 if $$FIND1^DIC(51.24,"","MX","SUPPOSITORY(IES)")>0
DO BMES^XPDUTL("Dose Unit Entry Modified")
+7 QUIT
+8 ;;
