PRCH65.m

PRCH65 ;WISC/REW/SC-Deletes Delivery Schedules for already deleted items

 ;;5.0;IFCAP;**65**;4/21/95

 ;

AZPSCH N PR,DAA,IEN4428,PO,DIK,MSG,DA

 S DIK="^PRC(442.8,"

 S PR=0 F  S PR=$O(^PRC(442.8,"AC",PR)) Q:PR=""  D

 .  S DAA=0 F  S DAA=$O(^PRC(442.8,"AC",PR,DAA)) Q:DAA'=+DAA  D

 .  .  S IEN4428=0 F  S IEN4428=$O(^PRC(442.8,"AC",PR,DAA,IEN4428)) Q:IEN4428'=+IEN4428  D

 .  .  .  S PO=$O(^PRC(442,"B",PR,0))

 .  .  .  I PO="" D KILL Q

 .  .  .  I '$D(^PRC(442,+PO,2,DAA)) D KILL Q

 .  .  .  Q

 .  .  Q

 .  Q

 Q

 ;

KILL S MSG(1)=" "

 S MSG(2)=">>> Patch 65 is deleting delivery schedule : "_IEN4428

 S MSG(3)="    since "_$S('PO:"no purchase order presently exists named: "_PR_" [`"_PO_"]",1:"there is no item "_DAA_" in purchase order "_PR_" [`"_PO_"]")

 S MSG(4)=" "

 D MES^XPDUTL(.MSG)

 S DA=IEN4428 D ^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCH65   834     printed  Apr 09, 2024@21:08:55                                                                                                                                                                                                       Page 2

PRCH65    ;WISC/REW/SC-Deletes Delivery Schedules for already deleted items

 +1       ;;5.0;IFCAP;**65**;4/21/95

 +2       ;

AZPSCH     NEW PR,DAA,IEN4428,PO,DIK,MSG,DA

 +1        SET DIK="^PRC(442.8,"

 +2        SET PR=0

           FOR 

               SET PR=$ORDER(^PRC(442.8,"AC",PR))

               if PR=""

                   QUIT 

               Begin DoDot:1

 +3                SET DAA=0

                   FOR 

                       SET DAA=$ORDER(^PRC(442.8,"AC",PR,DAA))

                       if DAA'=+DAA

                           QUIT 

                       Begin DoDot:2

 +4                        SET IEN4428=0

                           FOR 

                               SET IEN4428=$ORDER(^PRC(442.8,"AC",PR,DAA,IEN4428))

                               if IEN4428'=+IEN4428

                                   QUIT 

                               Begin DoDot:3

 +5                                SET PO=$ORDER(^PRC(442,"B",PR,0))

 +6                                IF PO=""

                                       DO KILL

                                       QUIT 

 +7                                IF '$DATA(^PRC(442,+PO,2,DAA))

                                       DO KILL

                                       QUIT 

 +8                                QUIT 

                               End DoDot:3

 +9                        QUIT 

                       End DoDot:2

 +10               QUIT 

               End DoDot:1

 +11       QUIT 

 +12      ;

KILL       SET MSG(1)=" "

 +1        SET MSG(2)=">>> Patch 65 is deleting delivery schedule : "_IEN4428

 +2        SET MSG(3)="    since "_$SELECT('PO:"no purchase order presently exists named: "_PR_" [`"_PO_"]",1:"there is no item "_DAA_" in purchase order "_PR_" [`"_PO_"]")

 +3        SET MSG(4)=" "

 +4        DO MES^XPDUTL(.MSG)

 +5        SET DA=IEN4428

           DO ^DIK

 +6        QUIT