source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFREG.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: 3.5 KB
Line 
1IBDFREG ;ALB/CJM - ENCOUNTER FORM (prints for a single patient);NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3MAIN(WITHDATA) ;
4 ; -- prints encounter forms, either with patient data for a patient
5 ; with no appointment (in which case it uses time of printing as
6 ; the appointment time) or without patient data (only if a form
7 ; is defined for the clinic for such use)
8 ; $G(WITDATA) if the form should be printed with data
9 ; 0 if a blank form for use without patient data should be printed
10 ;
11 N IBF,FORMS,NODE,IBPM
12 ;FORMS = list of forms in form^form^... format
13 ;IBI is a counter used to parse FORMS
14 ;IBPM=1 if forms defined in print manager should be printed
15 N IBFLAG
16 S IBFLAG=1
17 S WITHDATA=+$G(WITHDATA)
18 K ^TMP("IB",$J),^TMP("IBDF",$J)
19 S (IBPM,IBQUIT)=0
20 D CLINIC G:IBQUIT EXIT
21 I WITHDATA D G:IBQUIT EXIT
22 .D NOW
23 .D WHCHFORM
24 D DEVICE G:IBQUIT EXIT
25QUEUED ;
26 ;input - DFN,IBAPPT,IBCLINIC
27 N IBDEVICE
28 ;
29 D DEVICE^IBDFUA(0,.IBDEVICE)
30 F IBF=1:1 S IBFORM=$P(FORMS,"^",IBF) Q:'IBFORM D DRWFORM^IBDF2A(IBFORM,WITHDATA,.IBDEVICE)
31 I WITHDATA,IBPM D PRNTOTHR^IBDF1B5(IBCLINIC,IBAPPT,DFN)
32EXIT ;
33 I $D(ZTQUEUED) S ZTREQ="@"
34 E D ^%ZISC
35 D KPRNTVAR^IBDFUA ;kills the screen and graphics parameters
36 K IBQUIT,IBFORM,IBCLINIC,IBAPPT,IBTYPE,X,Y,I,^TMP("IB",$J),^TMP("IBDF",$J),^TMP("RPT",$J),^TMP("DFN",$J)
37 Q
38FORM ;gets the type of form to print from the clinic setup - sets FORMS
39 N SETUP
40 S SETUP=$O(^SD(409.95,"B",IBCLINIC,"")) I 'SETUP D ERROR S IBQUIT=1 Q
41 S SETUP=$G(^SD(409.95,SETUP,0)) I SETUP="" D ERROR S IBQUIT=1 Q
42 S FORMS=$P(SETUP,"^",5) I 'FORMS D ERROR S IBQUIT=1 Q
43 Q
44ERROR ;prints a message
45 W !!,"There is no encounter form defined for this clinic that should print",!,"without patient data!",!
46 Q
47ERROR2 ;prints a message
48 W !!,"There are no forms defined to print for this clinic!",!
49 Q
50DEVICE ;
51 ; -- always ask with param as default
52 S %ZIS("A")="Select Encounter Form PRINTER: "
53 S %ZIS("B")=$P($G(^DG(43,1,0)),"^",48) S %ZIS="MQN",%ZIS("S")="I $E($P($G(^%ZIS(2,+$G(^%ZIS(1,Y,""SUBTYPE"")),0)),U),1,2)=""P-""" D ^%ZIS
54 I POP S IBQUIT=1 Q
55 S IBDFRION=ION
56 ;
57 ; -- ask only if parameter not defined
58 ;I $P($G(^DG(43,1,0)),"^",48)="" S %ZIS="MQN" D ^%ZIS Q:POP S IBDFRION=ION
59 ;
60 I IO=IO(0)!($E(IOST,1,2)["C-") W !,"Queuing to a CRT not allowed!" S IBQUIT=1 Q
61 S ZTRTN="QUEUED^IBDF1A",(ZTSAVE("WITHDATA"),ZTSAVE("IB*"),ZTSAVE("DFN"),ZTSAVE("FORMS"))="",ZTDTH=$H
62 S ZTDESC="IBD - PRINT ENCOUNTER FORM" D ^%ZTLOAD
63 ;W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
64 D HOME^%ZIS S IBQUIT=1 Q
65 Q
66CLINIC ;asks the user for the clinic
67 K DIR S DIR(0)="409.95,.01O",DIR("A")="PRINT AN ENCOUNTER FORM FOR WHICH CLINIC? " D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!(+Y<0)!('(+Y)) S IBQUIT=1 Q
68 S IBCLINIC=+Y
69 Q
70NOW ;sets IBAPPT to NOW
71 N %,%H,%I,X
72 D NOW^%DTC
73 S IBAPPT=%
74 Q
75WHCHFORM ;
76 S IBPM=0,FORMS=""
77 S Y=2 S FORMS=$$FORMS^IBDF1B2(IBCLINIC,DFN,IBAPPT),IBPM=1
78 I '$P(FORMS,"^"),IBPM,'$$IFOTHR^IBDF1B5(IBCLINIC,"FOR EVERY APPOINTMENT"),'$$IFOTHR^IBDF1B5(IBCLINIC,"ONLY FOR EARLIEST APPOINTMENT") D ERROR2 S IBQUIT=1 Q
79 Q
80 ;
81WI(DFN,IBCLINIC,IBAPPT) ; -- procedure
82 ; -- print encounter form for walk-ins (not tested)
83 N DIR,IBQUIT,IBF,FORMS,NODE,IBPM,IBDFWI,WITHDATA
84 S IBQUIT=0
85 G:'$G(DFN) WIQ
86 G:'$G(IBAPPT) WIQ
87 ;
88 S DIR(0)="Y",DIR("A")="DO YOU WANT TO PRINT AN ENCOUNTER FORM NOW"
89 W ! D ^DIR K DIR G WIQ:$D(DIRUT)!(Y=0)
90 ;
91 I '$G(IBCLINIC) D CLINIC G:IBQUIT WIQ
92 ;
93 S (IBDFWI,WITHDATA)=1
94 K ^TMP("IB",$J),^TMP("IBDF",$J)
95 S (IBPM,IBQUIT)=0
96 D WHCHFORM
97 D DEVICE G:IBQUIT WIQ ;automatically queues form
98 D QUEUED
99WIQ Q
Note: See TracBrowser for help on using the repository browser.