- 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 Jan 18, 2025@03:06:32 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