RMPFET5 ;DDC/KAW-ENTER/EDIT ORDER INFORMATION [ 06/16/95   3:06 PM ]
 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
 ;;input:  DFN,RMPFX,RMPFTYP,RMPFHAT,RMPFTP,RMPFSL (opt)
 ;;output: None
 Q:'$D(RMPFX)  Q:'RMPFX
 I '$D(^RMPF(791810,RMPFX,0)) W $C(7),"*** ORDER DOES NOT EXIST ***" Q
 G END:'RMPFTYP!(RMPFHAT="")!(RMPFTP="")
 D SUB G END:$D(RMPFOUT)
 D ^RMPFET2:RMPFTP="P"
END K DIR,DIE,DR,DA,DR,DI,D0,I,RMPFHAT,RMPFTYP,S0,RMPFSL,RMPFMOD,RM
 K RMPFDUP,X,Y Q
SUB ;;Enter/Edit fields that apply to order type
 ;; input: RMPFTYP,RMPFST (opt.)
 ;;output: None
 S DR="" K RMPFMOD
 I '$D(RMPFSL) S X=0 F I=1:1 S X=$O(^RMPF(791810.1,RMPFTYP,100,X)) Q:'X  S Y=$P(^(X,0),U,2) I Y'="" S DR=DR_$S(DR="":Y,1:";"_Y)
 I $D(RMPFSL) S X=0 F I=1:1 S X=$O(RMPFSL(X)) Q:X=""  I $D(^RMPF(791810.1,RMPFTYP,100,X,0)) S Y=$P(^(0),U,2) I Y'="" S DR=DR_$S(DR="":Y,1:";"_Y)
 Q:DR=""  W ! S DIE="^RMPF(791810,",DA=RMPFX D ^DIE
 I $D(RMPFMOD) D ^RMPFET6 Q:$D(RMPFOUT)
 K RMPFSL Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFET5   972     printed  Sep 23, 2025@20:12:41                                                                                                                                                                                                      Page 2
RMPFET5   ;DDC/KAW-ENTER/EDIT ORDER INFORMATION [ 06/16/95   3:06 PM ]
 +1       ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
 +2       ;;input:  DFN,RMPFX,RMPFTYP,RMPFHAT,RMPFTP,RMPFSL (opt)
 +3       ;;output: None
 +4        if '$DATA(RMPFX)
               QUIT 
           if 'RMPFX
               QUIT 
 +5        IF '$DATA(^RMPF(791810,RMPFX,0))
               WRITE $CHAR(7),"*** ORDER DOES NOT EXIST ***"
               QUIT 
 +6        if 'RMPFTYP!(RMPFHAT="")!(RMPFTP="")
               GOTO END
 +7        DO SUB
           if $DATA(RMPFOUT)
               GOTO END
 +8        if RMPFTP="P"
               DO ^RMPFET2
END        KILL DIR,DIE,DR,DA,DR,DI,D0,I,RMPFHAT,RMPFTYP,S0,RMPFSL,RMPFMOD,RM
 +1        KILL RMPFDUP,X,Y
           QUIT 
SUB       ;;Enter/Edit fields that apply to order type
 +1       ;; input: RMPFTYP,RMPFST (opt.)
 +2       ;;output: None
 +3        SET DR=""
           KILL RMPFMOD
 +4        IF '$DATA(RMPFSL)
               SET X=0
               FOR I=1:1
                   SET X=$ORDER(^RMPF(791810.1,RMPFTYP,100,X))
                   if 'X
                       QUIT 
                   SET Y=$PIECE(^(X,0),U,2)
                   IF Y'=""
                       SET DR=DR_$SELECT(DR="":Y,1:";"_Y)
 +5        IF $DATA(RMPFSL)
               SET X=0
               FOR I=1:1
                   SET X=$ORDER(RMPFSL(X))
                   if X=""
                       QUIT 
                   IF $DATA(^RMPF(791810.1,RMPFTYP,100,X,0))
                       SET Y=$PIECE(^(0),U,2)
                       IF Y'=""
                           SET DR=DR_$SELECT(DR="":Y,1:";"_Y)
 +6        if DR=""
               QUIT 
           WRITE !
           SET DIE="^RMPF(791810,"
           SET DA=RMPFX
           DO ^DIE
 +7        IF $DATA(RMPFMOD)
               DO ^RMPFET6
               if $DATA(RMPFOUT)
                   QUIT 
 +8        KILL RMPFSL
           QUIT