source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDF6.m@ 619

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IBDF6 ;ALB/CJM - ENCOUNTER FORM - ENTRY FOR BUILDING A FORM ;NOV 16,1992
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**10,29,30**;APR 24, 1997
3 ;
4FORMLIST ;
5 N IBTKFORM,IBDEVICE,IBAPI,IOVL,IOHL,IOBRC,IOBLC,IOTRC,IOTLC,IBFORM
6 ;IBDEVICE stores parameters related to device for printing forms
7 D DEVICE^IBDFUA(1,.IBDEVICE)
8 S IBTKFORM=0 ;IBTKFORM=1 only for toolkit forms
9 S IBAPI("INDEX")="D IDXFORMS^IBDF6"
10 S IBAPI("SELECT")="D SELECT^IBDF6"
11 N IBFASTXT ;set to 1 for fast exit from system
12 S IBFASTXT=0
13 K XQORS,VALMEVL,DIR
14 S IBCLINIC=""
15 D CLINIC
16 I IBCLINIC D EN^VALM("IBDF CLINIC FORM LIST")
17 Q
18ONENTRY ;
19 D IDXFORMS
20 Q
21ONEXIT ;
22 D KILL^%ZISS
23 K ^TMP("IB",$J),^TMP("IBDF",$J),IBCLINIC,VALMY,IBQUIT,VALMBCK,X,Y,I,DA,D0
24 Q
25EDITFORM ;allows user to select a form, then displays it for edit
26 N IBFORM,ARY,DFN,IBAPPT,RTNLIST,IBPRINT
27 S ARY="^TMP(""IBDF"",$J,""TEMPORARY CLINIC LIST"")"
28 ;
29 K @ARY
30 S VALMBCK=""
31 I $G(IBAPI("SELECT"))'="" X IBAPI("SELECT")
32 I IBFORM D CLINICS^IBDFU4(IBFORM,ARY) I $G(@ARY@(0))>1 W !,"The form is in use by other clinics!" D LIST^IBDFU4(ARY,4) S DIR(0)="Y",DIR("A")="Still want to edit",DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!(Y=0) S IBFORM=""
33 K ARY
34 I IBFORM,'$$LOCKFRM2^IBDFU7(IBFORM) D LOCKMSG2^IBDFU7(IBFORM) S IBFORM=""
35 I IBFORM D PRNTPRMS^IBDFU1C(.IBPRINT,0,1,0,1),UNCMPL^IBDF19(IBFORM,0),EN^VALM("IBDF DISPLAY FORM FOR EDIT"),UNCMPL^IBDF19(IBFORM,0),FREEFRM2^IBDFU7(IBFORM)
36 S VALMBCK="R"
37 Q
38 ;
39CLINIC ;
40 N DIR,DIC,DIE,DR,DA
41 S DIR(0)="409.95,.01",DIR("A")="EDIT FORMS FOR WHICH CLINIC? "
42 D ^DIR
43 K DIR
44 I $D(DIRUT)!(+Y<0) Q
45 S IBCLINIC=+Y
46 Q
47 ;
48IDXFORMS ;build an array of forms used by IBCLINIC for the list processor
49 N FORM,SETUP,NODE,SUB,SUBREC,USE,ID
50 K @VALMAR
51 S SETUP="",VALMCNT=0,ID=0
52 S SETUP=$O(^SD(409.95,"B",IBCLINIC,"")) Q:'SETUP
53 S NODE=$G(^SD(409.95,SETUP,0)) Q:NODE=""
54 F SUB=2,6,8,9,3,4,5,7 S FORM=$P(NODE,"^",SUB) I FORM D
55 .I $D(^IBE(357,FORM,0)) D
56 ..S USE=""
57 ..D ENTRY
58 Q
59ENTRY ;adds an entry to the array
60 S USE=USE_$S(SUB=2:"Basic Encounter Form",SUB=3:"Supplemental Form - Established Patients",SUB=4:"Supplemental Form - New Patients",SUB=5:"Form To Print With No Patient Data",1:"")
61 S:USE="" USE=USE_$S(SUB=7:"For Future Use",1:"Supplemental Form - All Patients")
62 S ID=ID+1,VALMCNT=VALMCNT+1,@VALMAR@(VALMCNT,0)=$$DISPLAY1(FORM,USE,ID),@VALMAR@("IDX",VALMCNT,ID)=FORM D FLDCTRL^VALM10(VALMCNT) ;set video for ID column
63 S VALMCNT=VALMCNT+1,@VALMAR@(VALMCNT,0)=$$DISPLAY2(FORM),@VALMAR@("IDX",VALMCNT,ID)=FORM_"^"_$S(SUB=2:.02,SUB=3:.03,SUB=4:.04,SUB=5:.05,SUB=6:.06,SUB=7:.07,SUB=8:.08,SUB=9:.09,1:0)
64 Q
65HDR ;
66 S VALMHDR(1)="FORMS CURRENTLY USED BY '"_$$CLNCNAME_"' HOSPITAL LOCATION"
67 Q
68CLNCNAME() ;
69 Q $P($G(^SC(IBCLINIC,0)),"^",1)
70DISPLAY1(FORM,USE,ID) ;
71 N NODE,NAME,RET
72 S RET=$J(ID,3)_$$SP(2)
73 S NODE=$G(^IBE(357,FORM,0))
74 S NAME=$P(NODE,"^",1)
75 S RET=RET_$$PR(NAME,30)_$$SP(2)_USE
76 Q RET
77DISPLAY2(FORM) ;
78 N NODE,DESCR,RET
79 S RET=$$SP(37)
80 S NODE=$G(^IBE(357,FORM,0))
81 S DESCR=$P(NODE,"^",3)
82 S RET=RET_$E(DESCR,1,80)
83 Q RET
84PR(STR,LEN) ; pad right
85 Q:'$G(LEN) ""
86 N B S STR=$E($G(STR),1,LEN)
87 S:LEN'=$L(STR) $P(B," ",LEN-$L($G(STR)))=" "
88 Q STR_$G(B)
89SP(LEN) ;
90 Q:'$G(LEN)
91 N S S $P(S," ",LEN)=" "
92 Q S
93CHNGCLNC ;allows the user to change the clinic
94 N SAVECLNC S SAVECLNC=IBCLINIC
95 D FULL^VALM1
96 S VALMBCK="R"
97 D CLINIC I 'IBCLINIC S IBCLINIC=SAVECLNC Q
98 D HDR
99 X IBAPI("INDEX")
100 Q
101 ;
102SELECT ;
103 N SEL
104 D EN^VALM2(XQORNOD(0),"S")
105 S SEL=$O(VALMY(""))
106 S IBFORM=$S('SEL:"",1:+$G(@VALMAR@("IDX",2*SEL,SEL)))
107 Q
Note: See TracBrowser for help on using the repository browser.