PSS1P201.m

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 ---PSS1P201   2515     printed  Mar 13, 2025@21:33:52                                                                                                                                                                                                    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       ;;