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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTPPRE 743 printed Dec 13, 2024@02:35:58 Page 2
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
