source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF1B2.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1IBDF1B2 ;ALB/CJM - ENCOUNTER FORM PRINT (IBDF1B1 continued - user options for printing); 3/1/93
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4PRNTFRMS ;print encounter form(s) for an appointment
5 N FORMS,IBFORM,IBF
6 ;FORMS - list of forms to print for patient
7 ;IBF - a counter used to parse FORMS
8 S FORMS=$$FORMS(IBCLINIC,DFN,IBAPPT)
9 F IBF=1:1 S IBFORM=$P(FORMS,"^",IBF) Q:'IBFORM D DRWFORM^IBDF2A(IBFORM,1,.IBDEVICE)
10 Q
11 ;
12FORMS(CLINIC,DFN,IBAPPT) ;returns a list of forms that should be printed for this patient in this clinic and this appt.
13 N FORMS,SETUP,TYPE
14 S FORMS=""
15 S SETUP=$O(^SD(409.95,"B",+CLINIC,0)),SETUP=$G(^SD(409.95,+SETUP,0))
16 S:$P(SETUP,"^",2) FORMS=$P(SETUP,"^",2)_"^"
17 S:$P(SETUP,"^",6) FORMS=FORMS_$P(SETUP,"^",6)_"^"
18 S:$P(SETUP,"^",8) FORMS=FORMS_$P(SETUP,"^",8)_"^"
19 S:$P(SETUP,"^",9) FORMS=FORMS_$P(SETUP,"^",9)_"^"
20 I $P(SETUP,"^",3)!$P(SETUP,"^",4) D
21 .D TYPE
22 .I TYPE="NEW",$P(SETUP,"^",4) S FORMS=FORMS_$P(SETUP,"^",4)_"^"
23 .I TYPE="OLD",$P(SETUP,"^",3) S FORMS=FORMS_$P(SETUP,"^",3)_"^"
24 Q FORMS
25TYPE ;determine if patient is NEW or OLD at clinic - quick and dirty
26 N APPT,NODE
27 S TYPE="NEW"
28 S APPT=DT-10000 F S APPT=$O(^DPT(DFN,"S",APPT)) Q:('APPT)!(APPT'<IBAPPT) S NODE=$G(^DPT(DFN,"S",APPT,0)) I +NODE=CLINIC,(($P(NODE,"^",2)="I")!($P(NODE,"^",2)="NT")!($P(NODE,"^",2)="")) S TYPE="OLD" Q
29 Q
Note: See TracBrowser for help on using the repository browser.