source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFN1.m@ 1484

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1IBDFN1 ;ALB/CJM - ENCOUNTER FORM - INTERFACE ROUTINES ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3CLINIC ;returns clinic name
4 S @IBARY=$S($G(IBCLINIC):$P($G(^SC(IBCLINIC,0)),"^",1),1:"UNSPECIFIED")
5 Q
6DIVISION ;returns the name of the division of IBCLINIC in ien^name format
7 Q:'$G(IBCLINIC)
8 S @IBARY=$P($$DIVISION^IBDF1B5(+IBCLINIC),"^",2)
9 Q
10INST ;returns the name of the institution of IBCLINIC
11 Q:'$G(IBCLINIC)
12 N INST
13 S INST=$P($G(^SC(IBCLINIC,0)),"^",4)
14 I 'INST S INST=+$$DIVISION^IBDF1B5(+IBCLINIC) S:INST INST=$P($$SITE^VASITE(,INST),"^")
15 S:INST INST=$$GET1^DIQ(4,INST,.01)
16 S @IBARY=INST
17 Q
18 ;
19SAMEDAY ;get all future, same day appts
20 N TO
21 S TO=(IBAPPT\1)+.999999
22 D GETAPPTS(TO)
23 Q
24 ;
25ALLFUTR ;get all future appts
26 D GETAPPTS()
27 Q
28 ;
29CLNCFUTR ;get all future appts for the same clinic
30 Q:'$G(IBCLINIC)
31 D GETAPPTS("",IBCLINIC)
32 Q
33 ;
34GETAPPTS(TO,CLINIC) ;
35 Q:'$G(DFN)!('$G(IBAPPT))
36 N CNT,SUB,NODE,TIME
37 K VASD,VADPT
38 S VASD("F")=IBAPPT
39 S:$G(TO) VASD("T")=TO
40 S:$G(CLINIC) VASD("C",CLINIC)=""
41 D SDA^VADPT
42 I '$G(VAERR) S (SUB,CNT)=0 F S SUB=$O(^UTILITY("VASD",$J,SUB)) Q:'SUB D
43 .S NODE=$G(^UTILITY("VASD",$J,SUB,"E")) Q:NODE=""
44 .S CNT=CNT+1
45 .S TIME=$P(NODE,"^",1)
46 .S @IBARY@(CNT)=$P(TIME,"@",1)_"^"_$P(TIME,"@",2)_"^"_NODE
47 K ^UTILITY("VASD",$J),VADPT,VASD,VAERR
48 Q
Note: See TracBrowser for help on using the repository browser.