PSOFIXVS ;BIR/HTW-Data Cleanup Utility; [ 09/08/95 12:38 PM ]
;;6.0;OUTPATIENT PHARMACY;**140,142**;APRIL 1993
VERIFY ;
W !!,"Checking Rx Verify File"
S CT=0
S I="" F S I=$O(^PS(52.4,"B",I)) Q:I="" I '$D(^PSRX(I)) D
.S DIK="^PS(52.4,",DA=I D ^DIK K DIK,DA
.S CT=CT+1
.I CT=1 W !!,"Entries deleted from Rx Verify File (52.4): "
.W !,I
W !!,$G(CT)," Entries deleted from Rx Verify File (52.4)."
SUSPENSE ;
W !!,"Checking Rx Suspense File"
S CT=0
F I=0:0 S I=$O(^PS(52.5,"B",I)) Q:'I I '$D(^PSRX(I)) D
.S I525=$O(^PS(52.5,"B",I,"")) Q:'I525
.I '$D(^PS(52.5,I525)) K ^PS(52.5,"B",I,I525) Q
.S DIK="^PS(52.5,",DA=I525 D ^DIK K DIK,DA
.S CT=CT+1
.I CT=1 W !!,"Entries deleted from Rx Suspense File (52.5): "
.W !,I525 K I525
W !!,$G(CT)," Entries deleted from Rx Suspense File (52.5)."
K CT,I
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOFIXVS 838 printed Dec 13, 2024@02:29:28 Page 2
PSOFIXVS ;BIR/HTW-Data Cleanup Utility; [ 09/08/95 12:38 PM ]
+1 ;;6.0;OUTPATIENT PHARMACY;**140,142**;APRIL 1993
VERIFY ;
+1 WRITE !!,"Checking Rx Verify File"
+2 SET CT=0
+3 SET I=""
FOR
SET I=$ORDER(^PS(52.4,"B",I))
if I=""
QUIT
IF '$DATA(^PSRX(I))
Begin DoDot:1
+4 SET DIK="^PS(52.4,"
SET DA=I
DO ^DIK
KILL DIK,DA
+5 SET CT=CT+1
+6 IF CT=1
WRITE !!,"Entries deleted from Rx Verify File (52.4): "
+7 WRITE !,I
End DoDot:1
+8 WRITE !!,$GET(CT)," Entries deleted from Rx Verify File (52.4)."
SUSPENSE ;
+1 WRITE !!,"Checking Rx Suspense File"
+2 SET CT=0
+3 FOR I=0:0
SET I=$ORDER(^PS(52.5,"B",I))
if 'I
QUIT
IF '$DATA(^PSRX(I))
Begin DoDot:1
+4 SET I525=$ORDER(^PS(52.5,"B",I,""))
if 'I525
QUIT
+5 IF '$DATA(^PS(52.5,I525))
KILL ^PS(52.5,"B",I,I525)
QUIT
+6 SET DIK="^PS(52.5,"
SET DA=I525
DO ^DIK
KILL DIK,DA
+7 SET CT=CT+1
+8 IF CT=1
WRITE !!,"Entries deleted from Rx Suspense File (52.5): "
+9 WRITE !,I525
KILL I525
End DoDot:1
+10 WRITE !!,$GET(CT)," Entries deleted from Rx Suspense File (52.5)."
+11 KILL CT,I
+12 QUIT
