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 ---[H[J[2J[HPRCH65 834 printed Dec 13, 2024@02:05:20 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
