RMPRKIL.m

RMPRKIL ;JLT/PHX-REMOVE PROSTHETICS LOAN PROGRAM ;08/12/1994

 ;;3.0;PROSTHETICS;;Feb 09, 1996

 F RMPRL=0:0 S RMPRL=$O(^RMPR(660.1,RMPRL)) Q:RMPRL'>0  I $D(^RMPR(660.1,RMPRL,0)),$P(^(0),U,9)=1 S DIK="^RMPR(660.1,",DA=RMPRL D ^DIK

 K ^RMPR(660.1,"AF"),^RMPR(660.1,"AG"),DA,DIK

 F DA=.05,6,7,8,9,12,19,21,22 S DA(1)="660.1",DIK="^DD(660.1," D ^DIK

 S DIU=660.18,DIU(0)="S" D EN^DIU2

 K DA,DIK S DIK="^RMPR(660.2," D IXALL^DIK

 S DIU="^RMPR(660.2,",DIU(0)="D" D EN^DIU2 K DIU

OPT F OPT="RMPR LOAN DEL","RMPR LOAN CREATE","RMPR LOAN RET","RMPR LOAN DISP","RMPR LOAN FOLLOW-UP","RMPR LOAN PRINT ALL","RMPR LOAN EDIT","RMPR LOAN STAT","RMPR LOAN MENU" D

 .F REN=0:0 S REN=$O(^DIC(19,"B",OPT,REN)) Q:REN'>0  S DA=REN,DIK="^DIC(19," D ^DIK K DA,DIK

EXIT D KILL^XUSCLEAN Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPRKIL   774     printed  Apr 09, 2024@21:35:29                                                                                                                                                                                                      Page 2

RMPRKIL   ;JLT/PHX-REMOVE PROSTHETICS LOAN PROGRAM ;08/12/1994

 +1       ;;3.0;PROSTHETICS;;Feb 09, 1996

 +2        FOR RMPRL=0:0

               SET RMPRL=$ORDER(^RMPR(660.1,RMPRL))

               if RMPRL'>0

                   QUIT 

               IF $DATA(^RMPR(660.1,RMPRL,0))

                   IF $PIECE(^(0),U,9)=1

                       SET DIK="^RMPR(660.1,"

                       SET DA=RMPRL

                       DO ^DIK

 +3        KILL ^RMPR(660.1,"AF"),^RMPR(660.1,"AG"),DA,DIK

 +4        FOR DA=.05,6,7,8,9,12,19,21,22

               SET DA(1)="660.1"

               SET DIK="^DD(660.1,"

               DO ^DIK

 +5        SET DIU=660.18

           SET DIU(0)="S"

           DO EN^DIU2

 +6        KILL DA,DIK

           SET DIK="^RMPR(660.2,"

           DO IXALL^DIK

 +7        SET DIU="^RMPR(660.2,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

OPT        FOR OPT="RMPR LOAN DEL","RMPR LOAN CREATE","RMPR LOAN RET","RMPR LOAN DISP","RMPR LOAN FOLLOW-UP","RMPR LOAN PRINT ALL","RMPR LOAN EDIT","RMPR LOAN STAT","RMPR LOAN MENU"

               Begin DoDot:1

 +1                FOR REN=0:0

                       SET REN=$ORDER(^DIC(19,"B",OPT,REN))

                       if REN'>0

                           QUIT 

                       SET DA=REN

                       SET DIK="^DIC(19,"

                       DO ^DIK

                       KILL DA,DIK

               End DoDot:1

EXIT       DO KILL^XUSCLEAN

           QUIT