source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFQP.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1RMPFQP ;DDC/KAW-PRINT VA FORM 10-2477a; [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3RMPFSET 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"
6TYPE 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
11PAT1 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
15END 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
19PAT K DFN W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y Q
20READ 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
25SEL W !!,"Print an <O>rder, <P>atient data only or a <B>lank Form 10-2477a: "
26 D READ Q:$D(RMPFOUT)
27SEL1 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
30CHOOSE K RMPFX G CHE:'$D(RMPFS)
31 F I=1:1 Q:$Y>21 W !
32CH1 W !,"Select a Number or <RETURN> to continue: " D READ
33 G CHE:$D(RMPFOUT)
34CH2 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)
37CHE K RMPFS,Y Q
38QUE 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)
41NUM W !!,"Number of copies to print: 1// " D READ
42 Q:$D(RMPFOUT)
43NUM1 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
Note: See TracBrowser for help on using the repository browser.