source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1C.m@ 1578

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBDF1C ;ALB/CJM - ENCOUNTER FORM (print sample form) ; FEB 11,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**42**;APR 24, 1997
3 ;
4 ;This print routine forces queueing - so that allocation problems do not occur.
5 ;
6PRINT(IBFORM) ;
7 N IBQUIT,NODE,HT,WD S IBQUIT=0
8 D FULL^VALM1
9 S VALMBCK="R"
10 ;
11 I ('$G(IBFORM))!$G(IBTKBLK) N IBFORM D FORM G:IBQUIT EXIT
12 I $G(IBFORM) S NODE=$G(^IBE(357,IBFORM,0)),WD=$P(NODE,"^",9),HT=$P(NODE,"^",10) K NODE
13 D DEVICE,HOME^%ZIS G EXIT
14 ;
15QUEUED ; entry
16 D FORM^IBDF2A(IBFORM,0)
17 I $D(ZTQUEUED) S ZTREQ="@"
18 ;
19EXIT ;
20 K ZTSK,Y,X,J,D0,%,%I,D,DIC,DY,DX,I
21 Q
22 ;
23DEVICE ;
24 W !,"** You must queue the form to print. **"
25 W !,$C(7),"** This Encounter Form requires "_WD_" columns and a page length of "_HT_" lines. **",!
26 ;
27 ;queuing is automatic - the device is not opened
28 K %IS,%ZIS,IOP S %ZIS="N0Q",%ZIS("A")="Printer to queue to: ",%ZIS("B")="",%ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-""" D ^%ZIS
29 Q:POP
30 I $D(IO("S")) D G DEVICE
31 .W !!,"** Printer can not be a slave printer please try again.**",!
32 S ZTRTN="QUEUED^IBDF1C",ZTSAVE("IBFORM")="",ZTDESC="ENCOUNTER FORM",ZTDTH=$H D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
33 Q
34 ;
35FORM ;returns IBFORM
36 N P4
37 S IBFORM=0
38 ;if the user used the '=' syntax then assume he wants to choose from the list
39 S P4=$P(XQORNOD(0),"^",4)
40 I P4["==" S P4=$P(P4,"==")_"="_$P(P4,"==",2),$P(XQORNOD(0),"^",4)=P4
41 I $G(VALM("TITLE"))["FORMS",$P(P4,"=",2) D
42 .I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
43 .S:IBFORM Y(0)=$G(^IBE(357,IBFORM,0))
44 E D
45 .K DIR S DIR(0)="YA",DIR("A")="Do you want to print a form from the toolkit? "
46 .D ^DIR K DIR Q:(Y=-1)!($D(DIRUT))
47 .K DIC S DIC("S")=$S(Y:"I $P(^(0),U,7),$P(^(0),U)'=""WORKCOPY"",$P(^(0),U)'=""TOOL KIT""",1:"I '$P(^(0),U,7)"),DIC=357,DIC(0)="AEQZ",DIC("A")="Select any FORM by name: "
48 .D ^DIC K DIC Q:$D(DIRUT)!(Y<0)
49 .S IBFORM=+Y
50 I 'IBFORM S IBQUIT=1 Q
51 S WD=$P($G(Y(0)),"^",9),HT=$P($G(Y(0)),"^",10)
52 Q
Note: See TracBrowser for help on using the repository browser.