| 1 | RMPFQP ;DDC/KAW-PRINT VA FORM 10-2477a; [ 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 | W @IOF,!!,"PRINT VA FORM 10-2477a"
|
|---|
| 6 | TYPE D SEL G END:$D(RMPFOUT)!(Y="")
|
|---|
| 7 | S RMPFRTN=$S("Bb"[Y:"^RMPFQP2","Oo"[Y:"^RMPFQP3",1:"^RMPFQP4")
|
|---|
| 8 | G QUE:"Bb"[Y I "Pp"[Y D PAT G END:'$D(DFN),QUE
|
|---|
| 9 | D PAT G END:'$D(DFN)!$D(RMPFOUT) S (DX,CX)=0
|
|---|
| 10 | F I=1:1 S DX=$O(^RMPF(791810,"AE",DFN,DX)) Q:'DX S EX=0 F J=1:1 S EX=$O(^RMPF(791810,"AE",DFN,DX,EX)) Q:'EX S RMPFX=EX,CX=CX+1
|
|---|
| 11 | PAT1 I CX=0 W !!,"*** NO ORDERS EXIST FOR THIS PATIENT ***" G TYPE
|
|---|
| 12 | G QUE:CX=1 S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 I 'RMPFCX S CX=0 G PAT1
|
|---|
| 13 | D SEL^RMPFDX G END:$D(RMPFOUT),TYPE:'$D(RMPFX)
|
|---|
| 14 | D QUE G END:$D(RMPFOUT),RMPFSET
|
|---|
| 15 | END K RMPFRTN,RMPFORD,RMPFTP,RMPFP,RMPFX,RMPFS,RMPFR,RMPFOUT,RMPFQUT
|
|---|
| 16 | K EX,DX,CX,DFN,RMPFCNT,RMPFO,ZTSK,DISYS,J,I,KX,RMPFHAT
|
|---|
| 17 | K RMPFCX,RMPFRSTA,ZTRTN,ZTDESC,ZTIO,ZTSAVE,POP,%,%Y,%ZIS,X,Y,%T,C,DIC
|
|---|
| 18 | Q
|
|---|
| 19 | PAT K DFN W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y Q
|
|---|
| 20 | READ K RMPFOUT,RMPFQUT
|
|---|
| 21 | R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|---|
| 22 | I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|---|
| 23 | S:Y?1"?".E (RMPFQUT,Y)=""
|
|---|
| 24 | Q
|
|---|
| 25 | SEL W !!,"Print an <O>rder, <P>atient data only or a <B>lank Form 10-2477a: "
|
|---|
| 26 | D READ Q:$D(RMPFOUT)
|
|---|
| 27 | SEL1 I $D(RMPFQUT) W !!,"Enter an <O> to select an order to print,",!?7,"a <P> to print only the patient information or",!?7,"a <B> to print a blank Form 10-2477a." G SEL
|
|---|
| 28 | Q:Y="" S Y=$E(Y,1) I "OoBbPp"'[Y S RMPFQUT="" G SEL1
|
|---|
| 29 | K X Q
|
|---|
| 30 | CHOOSE K RMPFX G CHE:'$D(RMPFS)
|
|---|
| 31 | F I=1:1 Q:$Y>21 W !
|
|---|
| 32 | CH1 W !,"Select a Number or <RETURN> to continue: " D READ
|
|---|
| 33 | G CHE:$D(RMPFOUT)
|
|---|
| 34 | CH2 I $D(RMPFQUT) W !!,"Enter the number to the left of the order or",!?5,"<RETURN> to continue." G CH1
|
|---|
| 35 | G CHE:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G CH2
|
|---|
| 36 | S RMPFX=RMPFS(Y)
|
|---|
| 37 | CHE K RMPFS,Y Q
|
|---|
| 38 | QUE W ! S %ZIS="NPQ" D ^%ZIS Q:POP S RMPFCNT=1
|
|---|
| 39 | I IO=IO(0),'$D(IO("S")) D @(RMPFRTN) Q
|
|---|
| 40 | I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G @(RMPFRTN)
|
|---|
| 41 | NUM W !!,"Number of copies to print: 1// " D READ
|
|---|
| 42 | Q:$D(RMPFOUT)
|
|---|
| 43 | NUM1 I $D(RMPFQUT) W !!,"Enter a number from 1 to 10 for the number of copies to print." G NUM
|
|---|
| 44 | S:Y="" Y=1 I 'Y!(Y<1)!(Y>10) S RMPFQUT="" G NUM1
|
|---|
| 45 | S RMPFCNT=$P(Y,".",1)
|
|---|
| 46 | S ZTRTN=RMPFRTN,ZTDESC="FORM 10-2477a",ZTIO=ION,ZTSAVE("RM*")="",ZTSAVE("DFN")=""
|
|---|
| 47 | D ^%ZTLOAD,HOME^%ZIS Q:'$D(ZTSK)
|
|---|
| 48 | W:$D(ZTSK) !!,"*** Request Queued ***" H 1 Q
|
|---|
