- RMPFEC ;DDC/KAW-CHANGE ORDER OR BATCH STATUS [ 06/16/95 3:06 PM ]
- ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;JUN 16, 1995
- RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
- I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
- W @IOF,!!,"CHANGE ORDER OR BATCH STATUS"
- W !!?23,"*** WARNING ***"
- W !!,"This option should only be used when the status of an order",!,"or a batch cannot be changed through a software option."
- A1 W !!,"Edit an <O>rder, a <B>atch or <RETURN> to continue: "
- D READ G END:$D(RMPFOUT)
- A11 I $D(RMPFQUT) W !!,"Enter a <O> to edit the status of an order",!?6,"a <B> to enter the status of a batch or",!?8,"<RETURN> to continue." G A1
- G END:Y="" S Y=$E(Y,1) I "OoBb"'[Y S RMPFQUT="" G A11
- G BATCH:"Bb"[Y
- ORD W !! S DIC="^RMPF(791810,",DIC(0)="AEQM" S MN=$O(^RMPF(791810.5,"C",RMPFMENU,0))
- S DIC("S")="I $P($G(^RMPF(791810,+Y,""STA"")),"" - "",1)=$P(RMPFSTAP,"" - "",1),$P(^RMPF(791810,+Y,0),U,15)=MN"
- D ^DIC G RMPFSET:Y=-1
- S RMPFX=+Y,S0=^RMPF(791810,RMPFX,0)
- S RMPFTYP=$P(S0,U,2),RMPFST=$P(S0,U,3),(RMPFHAT,RMPFTP)=""
- I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2),RMPFTP=$P(^(0),U,3)
- I RMPFHAT=""!(RMPFTP="") W !!,$C(7),"*** ORDER INCOMPELTE ***" G ORDE
- I RMPFTP="P" S DFN=$P(S0,U,4) I 'DFN W !!,$C(7),"*** PATIENT NOT DEFINED ***" G END
- I RMPFTP="P" D PAT^RMPFUTL
- DISP D @("HEAD"_RMPFTP_"^RMPFDT1") S CN=1 W ! D ^RMPFDT2
- W !!,"Order Status: ",$P(^RMPF(791810.2,RMPFST,0),U,1)
- F Q:$Y>21 W !
- OR1 W !!,"Enter Number(s) of Line Item(s) to change: "
- D READ G END:$D(RMPFOUT)
- OR11 I $D(RMPFQUT) W !!,"Enter Line Item Numbers separated by commas or <RETURN> to exit." G OR1
- G END:Y="" F IX=1:1 S X=$P(Y,",",IX) Q:X="" I '$D(RMPFMD(X)) S RMPFQUT="" G OR11
- S ST=Y,X="NOW",%DT="T" D ^%DT S TD=Y
- S FY=0 F IX=1:1 S FY=$P(ST,",",IX) Q:FY="" S DA=RMPFMD(FY) D SET
- D ^RMPFET3 G DISP
- ORDE D DISPE^RMPFDT1,END^RMPFDT1 K DIC,X,Y,Y2,TD,SC,RMPFX,RMPFTYP,RMPFTP
- K RMPFST,RMPFHAT,IX,I,DFN Q
- SET S RMPFY=DA,RMPFTOT=0 W @IOF,"ORDER TO CHANGE:"
- D SHOW^RMPFDT2 W !
- S DIE="^RMPF(791810,"_RMPFX_",101,"
- S DR=".18;I X="" S Y="";.17////"_TD_";.2////1" D ^DIE Q
- BATCH W !! S DIC="^RMPF(791812,",DIC(0)="AEQM"
- S DIC("S")="I $P(^RMPF(791812,+Y,0),U,8)=RMPFSTAP,$P(^RMPF(791812,+Y,0),U,9)=$O(^RMPF(791810.5,""C"",RMPFMENU,0))"
- D ^DIC G RMPFSET:Y=-1
- S DIE=DIC,DA=+Y,DR=.02 D ^DIE G BATCH
- END K %,%DT,%Y,%T,C,I,D,D0,DA,DI,DIC,DIE,DQ,DR,T,X,Y,DISYS,MN
- Q
- READ K RMPFOUT,RMPFQUT
- R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
- I Y?1"^".E S (RMPFOUT,Y)="" Q
- S:Y?1"?".E (RMPFQUT,Y)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFEC 2703 printed Mar 13, 2025@21:41:11 Page 2
- RMPFEC ;DDC/KAW-CHANGE ORDER OR BATCH STATUS [ 06/16/95 3:06 PM ]
- +1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**16**;JUN 16, 1995
- RMPFSET ;;RMPFMENU must be defined
- IF '$DATA(RMPFMENU)
- DO MENU^RMPFUTL
- IF '$DATA(RMPFMENU)
- WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"
- QUIT
- +1 IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- DO ^RMPFUTL
- if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)
- QUIT
- +2 WRITE @IOF,!!,"CHANGE ORDER OR BATCH STATUS"
- +3 WRITE !!?23,"*** WARNING ***"
- +4 WRITE !!,"This option should only be used when the status of an order",!,"or a batch cannot be changed through a software option."
- A1 WRITE !!,"Edit an <O>rder, a <B>atch or <RETURN> to continue: "
- +1 DO READ
- if $DATA(RMPFOUT)
- GOTO END
- A11 IF $DATA(RMPFQUT)
- WRITE !!,"Enter a <O> to edit the status of an order",!?6,"a <B> to enter the status of a batch or",!?8,"<RETURN> to continue."
- GOTO A1
- +1 if Y=""
- GOTO END
- SET Y=$EXTRACT(Y,1)
- IF "OoBb"'[Y
- SET RMPFQUT=""
- GOTO A11
- +2 if "Bb"[Y
- GOTO BATCH
- ORD WRITE !!
- SET DIC="^RMPF(791810,"
- SET DIC(0)="AEQM"
- SET MN=$ORDER(^RMPF(791810.5,"C",RMPFMENU,0))
- +1 SET DIC("S")="I $P($G(^RMPF(791810,+Y,""STA"")),"" - "",1)=$P(RMPFSTAP,"" - "",1),$P(^RMPF(791810,+Y,0),U,15)=MN"
- +2 DO ^DIC
- if Y=-1
- GOTO RMPFSET
- +3 SET RMPFX=+Y
- SET S0=^RMPF(791810,RMPFX,0)
- +4 SET RMPFTYP=$PIECE(S0,U,2)
- SET RMPFST=$PIECE(S0,U,3)
- SET (RMPFHAT,RMPFTP)=""
- +5 IF RMPFTYP
- IF $DATA(^RMPF(791810.1,RMPFTYP,0))
- SET RMPFHAT=$PIECE(^(0),U,2)
- SET RMPFTP=$PIECE(^(0),U,3)
- +6 IF RMPFHAT=""!(RMPFTP="")
- WRITE !!,$CHAR(7),"*** ORDER INCOMPELTE ***"
- GOTO ORDE
- +7 IF RMPFTP="P"
- SET DFN=$PIECE(S0,U,4)
- IF 'DFN
- WRITE !!,$CHAR(7),"*** PATIENT NOT DEFINED ***"
- GOTO END
- +8 IF RMPFTP="P"
- DO PAT^RMPFUTL
- DISP DO @("HEAD"_RMPFTP_"^RMPFDT1")
- SET CN=1
- WRITE !
- DO ^RMPFDT2
- +1 WRITE !!,"Order Status: ",$PIECE(^RMPF(791810.2,RMPFST,0),U,1)
- +2 FOR
- if $Y>21
- QUIT
- WRITE !
- OR1 WRITE !!,"Enter Number(s) of Line Item(s) to change: "
- +1 DO READ
- if $DATA(RMPFOUT)
- GOTO END
- OR11 IF $DATA(RMPFQUT)
- WRITE !!,"Enter Line Item Numbers separated by commas or <RETURN> to exit."
- GOTO OR1
- +1 if Y=""
- GOTO END
- FOR IX=1:1
- SET X=$PIECE(Y,",",IX)
- if X=""
- QUIT
- IF '$DATA(RMPFMD(X))
- SET RMPFQUT=""
- GOTO OR11
- +2 SET ST=Y
- SET X="NOW"
- SET %DT="T"
- DO ^%DT
- SET TD=Y
- +3 SET FY=0
- FOR IX=1:1
- SET FY=$PIECE(ST,",",IX)
- if FY=""
- QUIT
- SET DA=RMPFMD(FY)
- DO SET
- +4 DO ^RMPFET3
- GOTO DISP
- ORDE DO DISPE^RMPFDT1
- DO END^RMPFDT1
- KILL DIC,X,Y,Y2,TD,SC,RMPFX,RMPFTYP,RMPFTP
- +1 KILL RMPFST,RMPFHAT,IX,I,DFN
- QUIT
- SET SET RMPFY=DA
- SET RMPFTOT=0
- WRITE @IOF,"ORDER TO CHANGE:"
- +1 DO SHOW^RMPFDT2
- WRITE !
- +2 SET DIE="^RMPF(791810,"_RMPFX_",101,"
- +3 SET DR=".18;I X="" S Y="";.17////"_TD_";.2////1"
- DO ^DIE
- QUIT
- BATCH WRITE !!
- SET DIC="^RMPF(791812,"
- SET DIC(0)="AEQM"
- +1 SET DIC("S")="I $P(^RMPF(791812,+Y,0),U,8)=RMPFSTAP,$P(^RMPF(791812,+Y,0),U,9)=$O(^RMPF(791810.5,""C"",RMPFMENU,0))"
- +2 DO ^DIC
- if Y=-1
- GOTO RMPFSET
- +3 SET DIE=DIC
- SET DA=+Y
- SET DR=.02
- DO ^DIE
- GOTO BATCH
- END KILL %,%DT,%Y,%T,C,I,D,D0,DA,DI,DIC,DIE,DQ,DR,T,X,Y,DISYS,MN
- +1 QUIT
- READ KILL RMPFOUT,RMPFQUT
- +1 READ Y:DTIME
- IF '$TEST
- WRITE $CHAR(7)
- READ Y:5
- if Y="."
- GOTO READ
- if '$TEST
- SET Y=U
- +2 IF Y?1"^".E
- SET (RMPFOUT,Y)=""
- QUIT
- +3 if Y?1"?".E
- SET (RMPFQUT,Y)=""
- +4 QUIT
