| 1 | IBDF1C ;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 | ;
|
|---|
| 6 | PRINT(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 | ;
|
|---|
| 15 | QUEUED ; entry
|
|---|
| 16 | D FORM^IBDF2A(IBFORM,0)
|
|---|
| 17 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 18 | ;
|
|---|
| 19 | EXIT ;
|
|---|
| 20 | K ZTSK,Y,X,J,D0,%,%I,D,DIC,DY,DX,I
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | DEVICE ;
|
|---|
| 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 | ;
|
|---|
| 35 | FORM ;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
|
|---|
