PSOFIXVS.m

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 ---PSOFIXVS   838     printed  Apr 09, 2024@21:32:01                                                                                                                                                                                                     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