49 lines
2.5 KiB
Mathematica
49 lines
2.5 KiB
Mathematica
RMPFQP ;DDC/KAW-PRINT VA FORM 10-2477a; [ 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)
|
|
W @IOF,!!,"PRINT VA FORM 10-2477a"
|
|
TYPE D SEL G END:$D(RMPFOUT)!(Y="")
|
|
S RMPFRTN=$S("Bb"[Y:"^RMPFQP2","Oo"[Y:"^RMPFQP3",1:"^RMPFQP4")
|
|
G QUE:"Bb"[Y I "Pp"[Y D PAT G END:'$D(DFN),QUE
|
|
D PAT G END:'$D(DFN)!$D(RMPFOUT) S (DX,CX)=0
|
|
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
|
|
PAT1 I CX=0 W !!,"*** NO ORDERS EXIST FOR THIS PATIENT ***" G TYPE
|
|
G QUE:CX=1 S (RMPFORD,RMPFTP)="P" D ^RMPFDS1 I 'RMPFCX S CX=0 G PAT1
|
|
D SEL^RMPFDX G END:$D(RMPFOUT),TYPE:'$D(RMPFX)
|
|
D QUE G END:$D(RMPFOUT),RMPFSET
|
|
END K RMPFRTN,RMPFORD,RMPFTP,RMPFP,RMPFX,RMPFS,RMPFR,RMPFOUT,RMPFQUT
|
|
K EX,DX,CX,DFN,RMPFCNT,RMPFO,ZTSK,DISYS,J,I,KX,RMPFHAT
|
|
K RMPFCX,RMPFRSTA,ZTRTN,ZTDESC,ZTIO,ZTSAVE,POP,%,%Y,%ZIS,X,Y,%T,C,DIC
|
|
Q
|
|
PAT K DFN W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y 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
|
|
SEL W !!,"Print an <O>rder, <P>atient data only or a <B>lank Form 10-2477a: "
|
|
D READ Q:$D(RMPFOUT)
|
|
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
|
|
Q:Y="" S Y=$E(Y,1) I "OoBbPp"'[Y S RMPFQUT="" G SEL1
|
|
K X Q
|
|
CHOOSE K RMPFX G CHE:'$D(RMPFS)
|
|
F I=1:1 Q:$Y>21 W !
|
|
CH1 W !,"Select a Number or <RETURN> to continue: " D READ
|
|
G CHE:$D(RMPFOUT)
|
|
CH2 I $D(RMPFQUT) W !!,"Enter the number to the left of the order or",!?5,"<RETURN> to continue." G CH1
|
|
G CHE:Y="" I '$D(RMPFS(Y)) S RMPFQUT="" G CH2
|
|
S RMPFX=RMPFS(Y)
|
|
CHE K RMPFS,Y Q
|
|
QUE W ! S %ZIS="NPQ" D ^%ZIS Q:POP S RMPFCNT=1
|
|
I IO=IO(0),'$D(IO("S")) D @(RMPFRTN) Q
|
|
I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G @(RMPFRTN)
|
|
NUM W !!,"Number of copies to print: 1// " D READ
|
|
Q:$D(RMPFOUT)
|
|
NUM1 I $D(RMPFQUT) W !!,"Enter a number from 1 to 10 for the number of copies to print." G NUM
|
|
S:Y="" Y=1 I 'Y!(Y<1)!(Y>10) S RMPFQUT="" G NUM1
|
|
S RMPFCNT=$P(Y,".",1)
|
|
S ZTRTN=RMPFRTN,ZTDESC="FORM 10-2477a",ZTIO=ION,ZTSAVE("RM*")="",ZTSAVE("DFN")=""
|
|
D ^%ZTLOAD,HOME^%ZIS Q:'$D(ZTSK)
|
|
W:$D(ZTSK) !!,"*** Request Queued ***" H 1 Q
|