RMPFEI ;DDC/KAW-ISSUE CUSTOM HEARING AIDS [ 06/16/95   3:06 PM ]
 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;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)
A0 W @IOF,!,"ISSUE CUSTOM HEARING AIDS"
A1 W !!,"Select Order by Patient Name or Purchase Order Number: "
 D READ G END:$D(RMPFOUT)
A11 I $D(RMPFQUT) W !!,"Enter the name of the patient or the Purchase Order Number of the order" G A1
 G END:Y="",PO:Y?1"G"5N1"-".E S DIC="^DPT(",DIC(0)="EQM"
 S X=Y D ^DIC G A0:Y=-1 S DFN=+Y,(X,CX,RMPFX)=0
 F  S RMPFX=$O(^RMPF(791810,"C",DFN,RMPFX)) Q:'RMPFX  D
 .D ARRAY^RMPFDT2 S Y=0
 .F  S Y=$O(RMPFO(Y)) Q:'Y  I RMPFO(Y)=5,$P($G(^RMPF(791810,RMPFX,101,Y,90)),U,9) S CX=CX+1,X=RMPFX Q
 I CX=0 D NONE,CONT^RMPFET G END:$D(RMPFOUT),A0
 I CX=1 S RMPFX=X G SET
 S RMPFP(5)="",(RMPFORD,RMPFTP)="P" D ^RMPFDS1
 K RMPFX D SEL^RMPFDX G END:$D(RMPFOUT),A0:'$D(RMPFX)
 D ARRAY^RMPFDT2 S Y=0 F  S Y=$O(RMPFO(Y)) Q:'Y  I RMPFO(Y)=5,$P($G(^RMPF(791810,RMPFX,101,Y,90)),U,9) Q
 I 'Y D NONE,CONT^RMPFET G END:$D(RMPFOUT),A0
 G SET
PO S X=Y,DIC="^RMPF(791810,",DIC(0)="EQM"
 S DIC("S")="I $P(^(0),U,3)=5" D ^DIC K DIC G A0:Y=-1 S RMPFX=+Y
SET S S0=^RMPF(791810,RMPFX,0),DFN=$P(S0,U,4)
 S RMPFTP="P",RMPFTYP=$P(S0,U,2)
 I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2)
DISP D ^RMPFET7 G END:$D(RMPFOUT) D ^RMPFET2 G END:$D(RMPFOUT)
 D ARRAY^RMPFDT2 S X=0 F  S X=$O(^RMPF(791810,RMPFX,101,X)) Q:'X  I $D(^(X,0)),$P(^(0),U,20),$P(^(0),U,19)["I" D APPROV1^RMPFEA2 Q
 G END:$D(RMPFOUT),A0
END K %,%Y,DFN,DIC,DISYS,I,RMPFHAT,RMPFO,RMPFST,RMPFTYP,RMPFOUT,RMPFCX
 K RMPFORD,RMPFP,RMPFS,RMPFX,%Y,%Y1,CT,RMPFQUT,RMPFTP,S0,X,Y Q
CONT F  Q:$Y>21  W !
 W !,"Type <RETURN> to continue." D READ Q
NONE W !!,"*** THERE ARE NO CERTIFIED LINE ITEMS TO BE ISSUED ***" 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