| [613] | 1 | RMPFEI ;DDC/KAW-ISSUE CUSTOM HEARING AIDS [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q ;;RMPFMENU must be defined
|
|---|
| 4 | I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)
|
|---|
| 5 | A0 W @IOF,!,"ISSUE CUSTOM HEARING AIDS"
|
|---|
| 6 | A1 W !!,"Select Order by Patient Name or Purchase Order Number: "
|
|---|
| 7 | D READ G END:$D(RMPFOUT)
|
|---|
| 8 | A11 I $D(RMPFQUT) W !!,"Enter the name of the patient or the Purchase Order Number of the order" G A1
|
|---|
| 9 | G END:Y="",PO:Y?1"G"5N1"-".E S DIC="^DPT(",DIC(0)="EQM"
|
|---|
| 10 | S X=Y D ^DIC G A0:Y=-1 S DFN=+Y,(X,CX,RMPFX)=0
|
|---|
| 11 | F S RMPFX=$O(^RMPF(791810,"C",DFN,RMPFX)) Q:'RMPFX D
|
|---|
| 12 | .D ARRAY^RMPFDT2 S Y=0
|
|---|
| 13 | .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
|
|---|
| 14 | I CX=0 D NONE,CONT^RMPFET G END:$D(RMPFOUT),A0
|
|---|
| 15 | I CX=1 S RMPFX=X G SET
|
|---|
| 16 | S RMPFP(5)="",(RMPFORD,RMPFTP)="P" D ^RMPFDS1
|
|---|
| 17 | K RMPFX D SEL^RMPFDX G END:$D(RMPFOUT),A0:'$D(RMPFX)
|
|---|
| 18 | 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
|
|---|
| 19 | I 'Y D NONE,CONT^RMPFET G END:$D(RMPFOUT),A0
|
|---|
| 20 | G SET
|
|---|
| 21 | PO S X=Y,DIC="^RMPF(791810,",DIC(0)="EQM"
|
|---|
| 22 | S DIC("S")="I $P(^(0),U,3)=5" D ^DIC K DIC G A0:Y=-1 S RMPFX=+Y
|
|---|
| 23 | SET S S0=^RMPF(791810,RMPFX,0),DFN=$P(S0,U,4)
|
|---|
| 24 | S RMPFTP="P",RMPFTYP=$P(S0,U,2)
|
|---|
| 25 | I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2)
|
|---|
| 26 | DISP D ^RMPFET7 G END:$D(RMPFOUT) D ^RMPFET2 G END:$D(RMPFOUT)
|
|---|
| 27 | 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
|
|---|
| 28 | G END:$D(RMPFOUT),A0
|
|---|
| 29 | END K %,%Y,DFN,DIC,DISYS,I,RMPFHAT,RMPFO,RMPFST,RMPFTYP,RMPFOUT,RMPFCX
|
|---|
| 30 | K RMPFORD,RMPFP,RMPFS,RMPFX,%Y,%Y1,CT,RMPFQUT,RMPFTP,S0,X,Y Q
|
|---|
| 31 | CONT F Q:$Y>21 W !
|
|---|
| 32 | W !,"Type <RETURN> to continue." D READ Q
|
|---|
| 33 | NONE W !!,"*** THERE ARE NO CERTIFIED LINE ITEMS TO BE ISSUED ***" Q
|
|---|
| 34 | READ K RMPFOUT,RMPFQUT
|
|---|
| 35 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 36 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 37 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 38 | Q
|
|---|
