PSOTPPRE.m

PSOTPPRE ;BIR/RTR-Patch 146 Pre Install routine ;07/27/03

 ;;7.0;OUTPATIENT PHARMACY;**146**;DEC 1997

 ;

 I $$PATCH^XPDUTL("PSO*7.0*146") Q

 N X,Y,DA,DIC

 N PSOTPLLX

 S PSOTPLLX="" F  S PSOTPLLX=$O(^PS(53,"B",PSOTPLLX)) Q:PSOTPLLX=""!($G(XPDABORT)=2)  D

 .I $$UP^XLFSTR(PSOTPLLX)="NON-VA" S XPDABORT=2 D

 ..D BMES^XPDUTL("Aborting install, NON-VA entry found in RX PATIENT STATUS File (#53).") S XPDABORT=2

 I $G(XPDABORT)=2 Q

START ;Add entry to file

 K DIC S DIC="^PS(53,",DIC(0)="",X="NON-VA",DIC("DR")="2////"_"NVA"_";3////"_30_";4////"_11_";5////"_1_";15////"_0_";16////"_0 K DD,DO D FILE^DICN K DA,DIC,X,DD,DO

 I Y<1 D BMES^XPDUTL("Aborting Install, cannot add NON-VA Rx Patient Status entry to File #53.") S XPDABORT=2

 Q

PSOTPPRE  ;BIR/RTR-Patch 146 Pre Install routine ;07/27/03

 +1       ;;7.0;OUTPATIENT PHARMACY;**146**;DEC 1997

 +2       ;

 +3        IF $$PATCH^XPDUTL("PSO*7.0*146")

               QUIT 

 +4        NEW X,Y,DA,DIC

 +5        NEW PSOTPLLX

 +6        SET PSOTPLLX=""

           FOR 

               SET PSOTPLLX=$ORDER(^PS(53,"B",PSOTPLLX))

               IF PSOTPLLX=""!($GET(XPDABORT)=2)

                   QUIT 

               Begin DoDot:1

 +7                IF $$UP^XLFSTR(PSOTPLLX)="NON-VA"

                       SET XPDABORT=2

                       Begin DoDot:2

 +8                        DO BMES^XPDUTL("Aborting install, NON-VA entry found in RX PATIENT STATUS File (#53).")

                           SET XPDABORT=2

                       End DoDot:2

               End DoDot:1

 +9        IF $GET(XPDABORT)=2

               QUIT 

START     ;Add entry to file

 +1        KILL DIC

           SET DIC="^PS(53,"

           SET DIC(0)=""

           SET X="NON-VA"

           SET DIC("DR")="2////"_"NVA"_";3////"_30_";4////"_11_";5////"_1_";15////"_0_";16////"_0

           KILL DD,DO

           DO FILE^DICN

           KILL DA,DIC,X,DD,DO

 +2        IF Y<1

               DO BMES^XPDUTL("Aborting Install, cannot add NON-VA Rx Patient Status entry to File #53.")

               SET XPDABORT=2

 +3        QUIT