IBDF1C ;ALB/CJM - ENCOUNTER FORM (print sample form) ; FEB 11,1992
;;3.0;AUTOMATED INFO COLLECTION SYS;**42**;APR 24, 1997
;
;This print routine forces queueing - so that allocation problems do not occur.
;
PRINT(IBFORM) ;
N IBQUIT,NODE,HT,WD S IBQUIT=0
D FULL^VALM1
S VALMBCK="R"
;
I ('$G(IBFORM))!$G(IBTKBLK) N IBFORM D FORM G:IBQUIT EXIT
I $G(IBFORM) S NODE=$G(^IBE(357,IBFORM,0)),WD=$P(NODE,"^",9),HT=$P(NODE,"^",10) K NODE
D DEVICE,HOME^%ZIS G EXIT
;
QUEUED ; entry
D FORM^IBDF2A(IBFORM,0)
I $D(ZTQUEUED) S ZTREQ="@"
;
EXIT ;
K ZTSK,Y,X,J,D0,%,%I,D,DIC,DY,DX,I
Q
;
DEVICE ;
W !,"** You must queue the form to print. **"
W !,$C(7),"** This Encounter Form requires "_WD_" columns and a page length of "_HT_" lines. **",!
;
;queuing is automatic - the device is not opened
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
Q:POP
I $D(IO("S")) D G DEVICE
.W !!,"** Printer can not be a slave printer please try again.**",!
S ZTRTN="QUEUED^IBDF1C",ZTSAVE("IBFORM")="",ZTDESC="ENCOUNTER FORM",ZTDTH=$H D ^%ZTLOAD W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
Q
;
FORM ;returns IBFORM
N P4
S IBFORM=0
;if the user used the '=' syntax then assume he wants to choose from the list
S P4=$P(XQORNOD(0),"^",4)
I P4["==" S P4=$P(P4,"==")_"="_$P(P4,"==",2),$P(XQORNOD(0),"^",4)=P4
I $G(VALM("TITLE"))["FORMS",$P(P4,"=",2) D
.I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
.S:IBFORM Y(0)=$G(^IBE(357,IBFORM,0))
E D
.K DIR S DIR(0)="YA",DIR("A")="Do you want to print a form from the toolkit? "
.D ^DIR K DIR Q:(Y=-1)!($D(DIRUT))
.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: "
.D ^DIC K DIC Q:$D(DIRUT)!(Y<0)
.S IBFORM=+Y
I 'IBFORM S IBQUIT=1 Q
S WD=$P($G(Y(0)),"^",9),HT=$P($G(Y(0)),"^",10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF1C 2035 printed Nov 22, 2024@18:01:21 Page 2
IBDF1C ;ALB/CJM - ENCOUNTER FORM (print sample form) ; FEB 11,1992
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**42**;APR 24, 1997
+2 ;
+3 ;This print routine forces queueing - so that allocation problems do not occur.
+4 ;
PRINT(IBFORM) ;
+1 NEW IBQUIT,NODE,HT,WD
SET IBQUIT=0
+2 DO FULL^VALM1
+3 SET VALMBCK="R"
+4 ;
+5 IF ('$GET(IBFORM))!$GET(IBTKBLK)
NEW IBFORM
DO FORM
if IBQUIT
GOTO EXIT
+6 IF $GET(IBFORM)
SET NODE=$GET(^IBE(357,IBFORM,0))
SET WD=$PIECE(NODE,"^",9)
SET HT=$PIECE(NODE,"^",10)
KILL NODE
+7 DO DEVICE
DO HOME^%ZIS
GOTO EXIT
+8 ;
QUEUED ; entry
+1 DO FORM^IBDF2A(IBFORM,0)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 ;
EXIT ;
+1 KILL ZTSK,Y,X,J,D0,%,%I,D,DIC,DY,DX,I
+2 QUIT
+3 ;
DEVICE ;
+1 WRITE !,"** You must queue the form to print. **"
+2 WRITE !,$CHAR(7),"** This Encounter Form requires "_WD_" columns and a page length of "_HT_" lines. **",!
+3 ;
+4 ;queuing is automatic - the device is not opened
+5 KILL %IS,%ZIS,IOP
SET %ZIS="N0Q"
SET %ZIS("A")="Printer to queue to: "
SET %ZIS("B")=""
SET %ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-"""
DO ^%ZIS
+6 if POP
QUIT
+7 IF $DATA(IO("S"))
Begin DoDot:1
+8 WRITE !!,"** Printer can not be a slave printer please try again.**",!
End DoDot:1
GOTO DEVICE
+9 SET ZTRTN="QUEUED^IBDF1C"
SET ZTSAVE("IBFORM")=""
SET ZTDESC="ENCOUNTER FORM"
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+10 QUIT
+11 ;
FORM ;returns IBFORM
+1 NEW P4
+2 SET IBFORM=0
+3 ;if the user used the '=' syntax then assume he wants to choose from the list
+4 SET P4=$PIECE(XQORNOD(0),"^",4)
+5 IF P4["=="
SET P4=$PIECE(P4,"==")_"="_$PIECE(P4,"==",2)
SET $PIECE(XQORNOD(0),"^",4)=P4
+6 IF $GET(VALM("TITLE"))["FORMS"
IF $PIECE(P4,"=",2)
Begin DoDot:1
+7 IF $GET(IBAPI("SELECT"))'=""
XECUTE IBAPI("SELECT")
+8 if IBFORM
SET Y(0)=$GET(^IBE(357,IBFORM,0))
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you want to print a form from the toolkit? "
+11 DO ^DIR
KILL DIR
if (Y=-1)!($DATA(DIRUT))
QUIT
+12 KILL DIC
SET DIC("S")=$SELECT(Y:"I $P(^(0),U,7),$P(^(0),U)'=""WORKCOPY"",$P(^(0),U)'=""TOOL KIT""",1:"I '$P(^(0),U,7)")
SET DIC=357
SET DIC(0)="AEQZ"
SET DIC("A")="Select any FORM by name: "
+13 DO ^DIC
KILL DIC
if $DATA(DIRUT)!(Y<0)
QUIT
+14 SET IBFORM=+Y
End DoDot:1
+15 IF 'IBFORM
SET IBQUIT=1
QUIT
+16 SET WD=$PIECE($GET(Y(0)),"^",9)
SET HT=$PIECE($GET(Y(0)),"^",10)
+17 QUIT
