close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDE7.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDE7.m@ 1093

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

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
1IBDFDE7 ;ALB/AAS - AICS Manual Data Entry, Entry point for Group Clinics ; 29-APR-96
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**36,51**;APR 24, 1997
3 ;
4 W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
5 ;
6% N %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBDA,IBY,IBQUIT,IBDF,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL,IBD,IBDCKOUT
7 N IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,PXCA,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDX,ANS,CLNAME,CLSETUP,IBDSC,FORM,FORMLST,IBDFDT
8 ;
9 I '$D(DT) D DT^DICRW
10 D HOME^%ZIS
11 W !!,"Data Entry of Encounter Forms for Group Clinics",!
12 ;
13STRT ; -- ask for Clinic, appt. date/time
14 ; list patients, allow to deselect
15 ; find all forms for appt., then go through 1 at a time
16 ; then send data for each patient
17 ;
18 D END W !
19 S IBQUIT=0
20 S (IBDSC,IBDF("CLINIC"))=$$SELCL^IBDFDE6 G:IBQUIT STRTQ
21 I IBDSC<1 S IBQUIT=1 G STRTQ
22 S CLNAME=$P($G(^SC(+IBDSC,0)),"^")
23 S CLSETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",+IBDSC,0)),0))
24 ;
25OVER ;
26 W !
27 S IBQUIT=0
28 S IBDFDT=$$SELAPT(.IBDF) G:IBQUIT STRTQ
29 I IBDFDT<0 G STRT
30 S IBDF("APPT")=IBDFDT
31 ;
32 D BLD
33 I '$D(^TMP("IBD-PL",$J,IBDF("CLINIC"))) W !!,"No valid appointments at that Date/Time!",!! G STRTQ
34 ;
35 D HDR^IBDFDE6,LIST^IBDFDE6
36 W !!
37 D EXCLUD
38 I IBQUIT=2 S IBQUIT=0 G STRTQ
39 G:IBQUIT STRTQ
40 ;
41 ; -- get first patient, check form(s)
42 ; do data entry on form and if okay pass data for all patients
43 S IBDSTRT=+$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),0))
44 S NODE=$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBDSTRT))
45 S (DFN,IBDFN)=+NODE
46 S FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
47 I FORMLST="" W !,"No forms Printed for first Patient" D ANYWAY^IBDFDE6
48 I FORMLST="" G OVERQ
49 S IBDF("SAVE")=1 ;save ibdsel(array)
50 F IBDX=1:1 S IBDF("FORM")=$P(FORMLST,"^",IBDX) Q:IBDF("FORM")="" I IBDF("FORM")'="" D EN^IBDFDE D
51 .I $G(IBDF("NOTHING"))!(IBQUIT) W !! Q
52 .D ALLPTS K IBDSEL,IBDPI Q:IBQUIT
53 K IBDF("SAVE")
54 ;
55OVERQ G OVER
56 ;
57STRTQ D PAUSE^IBDFDE G:IBQUIT END
58 G STRT
59 ;
60ALLPTS ; -- loop through all patients, merge ibdf=^tmp("ibd-save),
61 ; reset dfn, pass data to ibdfrpc4
62 N PARAM,FORMID,IBX,NODE
63 S FORMID=$P(^IBD(357.96,+IBDF("FORM"),0),"^",4)
64 S PARAM=$P($G(^IBD(357.09,1,0)),"^",7)
65 I $G(^TMP("IBD-SAVED",$J,"DYNAMIC")) W !!,"Form contains patient specific information, Not available for this option!",!! G ALLPTQ
66 S IBDA=IBDSTRT
67 F S IBDA=$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBDA)) Q:IBDA=""!(IBQUIT) D
68 .S IBX=IBDA
69 .S NODE=$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBX))
70 .M IBDF=^TMP("IBD-SAVED",$J)
71 .S (DFN,IBDF("DFN"))=+NODE
72 .S IBDF("SDOE")=$P(NODE,"^",22)
73 .S IBDF("FORM")=+$$FID^IBDF18C(DFN,IBDF("APPT"),1,FORMID,IBDF("CLINIC"))
74 .W !!,"Check out interview for: ",$P($G(^DPT(DFN,0)),"^")
75 .K IBDCO,IBDF("AO"),IBDF("SC"),IBDF("IR"),IBDF("EC"),IBDF("MST")
76 .D CHKOUT^IBDFDE0(IBDF("SDOE"))
77 .M IBDF=IBDCO
78 .D SEND^IBDFRPC4(.RESULT,.IBDF)
79 .I PARAM=3 D DISP^IBDFDE1
80 .I PARAM,$D(PXCA("ERROR"))!($D(PXCA("WARNING"))) D ERR^IBDFDE1
81 .I $P($G(^IBD(357.09,1,0)),"^",6) D MAKAPPT^IBDFDE1
82 ;
83 K ^TMP("IBD-SAVED",$J)
84ALLPTQ Q
85 ;
86SELAPT(IBDF) ; -- select appointment date/time for a clinic
87 N DIR,DA,DR,DIC,DIE,X,Y,ANS,DIRUT
88 S ANS=-1
89 S DIR(0)="DO^:NOW:AEXRT^D SCRN^IBDFDE7",DIR("A")="Appointment Date/Time"
90 S DIR("?")="Enter the date/time for the clinic that you wish to enter encounter forms for. Appointments must be present to enter the date time."
91 S DIR("??")="^D APDT^IBDFDE7"
92 D ^DIR K DIR
93 I $D(DIRUT) G SELAPQ
94 S ANS=+Y
95SELAPQ Q ANS
96 ;
97SCRN ; -- input transform logic for selecting an appointment date/time
98 I $G(IBDF("CLINIC"))="" K X
99 I '$D(^SC(IBDF("CLINIC"),"S",Y,1)) W $C(7),"?? No appointments that time." K X
100 Q
101 ;
102EXCLUD ; -- select patient(s) to process
103 S RESULT=""
104 S DIR("?")="Enter the number of the patient to exclude."
105 S DIR("??")="^D LIST^IBDFDE6"
106 S DIR(0)="FO^1:30",DIR("A")="Exclude Patient"
107 I RESULT'="" S DIR("A")="Exclude Another Patient"
108 D ^DIR K DIR
109 I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1 G EXCLUDQ
110 S ANS=Y
111 I ANS="" G EXCLUDQ
112 I ANS'=+ANS W !,"You must select a number from the list."
113 I ANS=+ANS,$D(^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS)) D
114 .S RESULT=^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS)
115 .K ^TMP("IBD-PL",$J,IBDF("CLINIC"),ANS),^TMP("IBD-PLN",$J,IBDF("CLINIC"),$P($G(^DPT(+RESULT,0)),"^"))
116 .W " ",$P($G(^DPT(+RESULT,0)),"^")," ","Excluded!"
117 ;
118 I '$D(^TMP("IBD-PL",$J,IBDF("CLINIC"))) W !!,"No patients left" S IBQUIT=2 G EXCLUDQ
119 ;
120 G EXCLUD
121EXCLUDQ Q
122 ;
123BLD ; -- Find all appointments for a date
124 K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J)
125 N SC,IBD,IBD1
126 S IBD=IBDFDT,SC=IBDF("CLINIC"),CNT=0
127 S IBD1=0 F S IBD1=$O(^SC(SC,"S",IBD,1,IBD1)) Q:'IBD1 D
128 .S NODE=$G(^SC(SC,"S",IBD,1,IBD1,0))
129 .S SNODE=$G(^DPT(+NODE,"S",IBD,0))
130 .S X=$P(SNODE,"^",2)
131 .I X'="","CNAPCA"[X Q ;inpatient appointments are okay
132 .S (DFN,IBDF("DFN"))=+NODE
133 .S CNT=CNT+1
134 .S ^TMP("IBD-PL",$J,SC,CNT)=DFN_"^"_IBD_"^"_SNODE
135 .S ^TMP("IBD-PLN",$J,SC,$P(^DPT(DFN,0),"^"))=DFN_"^"_IBD_"^"_SNODE
136 Q
137 ;
138LIST ; -- print list of patients
139 N IBD,IBJ,FORM,STATUS
140 S IBD=0 F S IBD=$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)) Q:'IBD D
141 .S DFN=+$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)),APPT=$P($G(^(IBD)),"^",2),SNODE=$P($G(^(IBD)),"^",3,99)
142 .S FORM=+$$FINDID^IBDF18C(DFN,APPT,"",1),STATUS="NO FORM PRINTED"
143 .I FORM S Y=$P($G(^IBD(357.96,+FORM,0)),"^",11),C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATUS=Y
144 .W !?2,IBD,?5,$E($P(^DPT(DFN,0),"^"),1,20),?29,$P($G(^DPT(DFN,.36)),"^",3),?43,$$FMTE^XLFDT(+APPT),?64,$E($G(STATUS),1,16)
145 Q
146 ;
147APDT ; -- list last 30 days appointment dates in clinic
148 S (X,Y)=$$FMADD^XLFDT(DT,-60),CNT=0
149 F S X=$O(^SC(IBDF("CLINIC"),"S",X)) Q:'X!(X>DT) D
150 .S Y=X,CNT=CNT+1
151 .I CNT=1 W !!,"The following are valid Appointment date/times in the past 60 days:"
152 .W:(CNT#3=1) !,?3,$$FMTE^XLFDT(Y)
153 .W:(CNT#3=2) ?30,$$FMTE^XLFDT(Y)
154 .W:(CNT#3=0) ?60,$$FMTE^XLFDT(Y)
155 Q
156 ;
157HDR ; -- print Clinic header
158 W @IOF
159 W !," Clinic: ",$E(CLNAME,1,25) W ?40," Date: ",$$FMTE^XLFDT(IBDFDT)
160 S FORM=$P(CLSETUP,"^",2),IBDFMNME=$P($G(^IBE(357,+FORM,0)),"^")
161 W !," Basic Form: ",$E(IBDFMNME,1,25) ;W ?40,"Form Status: ",$E(IBDFMSTE,1,25)
162 W !,$TR($J(" ",IOM)," ","=")
163 Q
164 ;
165END K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF,IBDA,SDFN
166 K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J),^TMP("IBD-SAVED",$J),^TMP("IBD-MORE",$J),^TMP("IBD-PLCHK",$J),^TMP("IBD-PL4",$J),^TMP("IBD-PLB",$J)
167 K ^TMP("IBD-ASK",$J),^TMP("IBD-LCODE",$J),^TMP("IBD-LST",$J),^TMP("IBD-LTEXT",$J),^TMP("IBD-OBJ",$J)
168 Q
Note: See TracBrowser for help on using the repository browser.