source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFDE0.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: 5.9 KB
Line 
1IBDFDE0 ;ALB/AAS - AICS Data Entry, Check out interview; 24-FEB-96
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29,36,44**;APR 24, 1997
3 ;
4% G ^IBDFDE
5 ;
6CHKOUT(SDOE) ; -- ask check out questions
7 ; -- assumes forms are always for an appointment
8 ; does not require provider, cpt, or diag. to input data
9 ; acts same as input from scanned form.
10 ;
11 S IBQUIT=0
12 W !!,">>> Check out interview..."
13 ;
14 ; -- can't check out future appointments
15 I $E(IBDF("APPT"),1,7)>DT W "not available at this time." G CHKOUTQ
16 ;
17 ; -- get encounter if not already there (won't work unless appt exists)
18 ;I 'SDOE S SDOE=$$GETAPT(DFN,IBDF("APPT"),IBDF("CLINIC"))
19 ;
20 ; -- see if already done, or needs to be done first
21 S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE,$G(IBDCKOUT))
22 I X<1 W $S(X=0:"no questions.",X=-2:"not required",X=-3:"already completed today",1:"already complete.") G CHKOUTQ
23 W "required."
24 ;
25 ; -- ask eligibility/appt type ;not unless asked for
26 ;S ELIG=$$ELAP^SDPCE(DFN,IBDF("APPT"))
27 ;
28 ; -- ask checkout Date
29 S IBDPRE=$G(IBDCO("CO"))
30 S X=$S($G(IBDCO("CO"))="":"NOW",1:$$FMTE^XLFDT(IBDCO("CO")))
31 S IBDCO("CO")=$E($$ASKDT("Checkout Date: ",X,"",IBDF("APPT"),$$FMADD^XLFDT(DT,1)),1,12)
32 I $G(IBDCO("CO"))="" K IBDCO W " Checkout Deleted!" G CHKOUTQ
33 I $G(IBDCO("CO"))<0 K:IBDPRE="" IBDCO("CO") W:IBDPRE="" " Checkout Deleted!" S:IBDPRE IBDCO("CO")=IBDPRE S IBQUIT=1 G CHKOUTQ
34 ;
35 ; -- ask classifications
36 I $$SC^SDCO22(DFN,+SDOE)!($D(IBDF("SC"))) S IBDCO("SC")=$$ASKYN("Was treatment for SC Condition",$G(IBDCO("SC")),"D SCCOND^IBDFN4") D
37 .I $G(IBDCO("SC"))="" K IBDCO("SC") W " Deleted!"
38 I $G(IBDCO("SC"))<0 K IBDCO("SC") S IBQUIT=1 G CHKOUTQ
39 ;
40 I $G(IBDCO("SC")) G MST ; if service connected others don't apply
41 ;
42 I $$AO^SDCO22(DFN,+SDOE)!($D(IBDF("AO"))) S IBDCO("AO")=$$ASKYN("Was treatment related to Agent Orange Exposure",$G(IBDCO("AO"))) D
43 .I $G(IBDCO("AO"))="" K IBDCO("AO") W " Deleted!"
44 I $G(IBDCO("AO"))<0 K IBDCO("AO") S IBQUIT=1 G CHKOUTQ
45 ;
46 I $$IR^SDCO22(DFN,+SDOE)!($D(IBDF("IR"))) S IBDCO("IR")=$$ASKYN("Was treatment related to Ionizing Radiation Exposure",$G(IBDCO("IR"))) D
47 .I $G(IBDCO("IR"))="" K IBDCO("IR") W " Deleted!"
48 I $G(IBDCO("IR"))<0 K IBDCO("IR") S IBQUIT=1 G CHKOUTQ
49 ;
50 I $$EC^SDCO22(DFN,+SDOE)!($D(IBDF("EC"))) S IBDCO("EC")=$$ASKYN("Was treatment related to Environmental Contaminant Exposure",$G(IBDCO("EC"))) D
51 .I $G(IBDCO("EC"))="" K IBDCO("EC") W " Deleted!"
52 I $G(IBDCO("EC"))<0 K IBDCO("EC") S IBQUIT=1 G CHKOUTQ
53 ;
54MST ;- Ask Military Sexual Trauma question (patch IBD*3*36)
55 I $$MST^SDCO22(DFN,+SDOE)!($D(IBDF("MST"))) S IBDCO("MST")=$$ASKYN("Was treatment related to MST (Note: ask provider only)",$G(IBDCO("MST"))) D
56 .I $G(IBDCO("MST"))="" K IBDCO("MST") W " Deleted!"
57 I $G(IBDCO("MST"))<0 K IBDCO("MST") S IBQUIT=1 G CHKOUTQ
58 ;
59 I '$D(IBDCO) W "no questions."
60CHKOUTQ I IBQUIT W !!,"Required information missing."
61 K IBDPRE,SDFN
62 Q
63 ;
64ASKYN(QUES,DEFLT,EXHELP) ; -- ask yes/no question
65 N DIR,DIRUT,DUOUT,DTOUT
66 I $G(EXHELP)'="" S DIR("??")="^"_EXHELP
67 S DIR("A")=QUES,DIR(0)="YO",DIR("B")=$S($G(DEFLT):"Yes",1:"No") D ^DIR
68 I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
69 I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
70 Q Y
71 ;
72ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,EXHELP) ; -- ask date questions
73 N X,Y,DIR,DIRUT,DTOUT,DUOUT
74 S DIR(0)="DOA^"_$E($G(EARLY),1,7)_":"_$G(LATEST)_":"_$S($G(PARAM)'="":PARAM,1:"AERX")
75 I $G(QUES)'="" S DIR("A")=QUES
76 I $G(DEFLT)'="" S DIR("B")=DEFLT
77 I $L($G(EXHELP)) S DIR("??")="^"_EXHELP
78 S DIR("?")="This response requires an appointment Date and Time"
79 D ^DIR
80 I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
81 I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
82 Q Y
83 ;
84REQ(DFN,APPT,CLINIC,SDOE,IBDC) ; is checkout interview required for this appt.
85 N IBDY S IBDY=0
86 I $$INP^SDAM2(DFN,APPT)="I" G REQQ ; inpatient appointment
87 I '$$CLINIC^SDAMU(CLINIC) G REQQ ; not a clinic or non-count
88 I $$REQ^SDM1A(APPT)'="CO" G REQQ ; checkout not required
89 I $$EXCL(CLINIC,APPT) S IBDY=-2 G REQQ ; clinic stop codes are exempt
90 I $$COMDT^SDCOU(+SDOE) S IBDY=-1 G REQQ ;process completed
91 I $P($G(IBDC),".")=DT S IBDY=-3 G REQQ ;already checked out today
92 S IBDY=1
93REQQ K SDFN
94 Q IBDY
95 ;
96EXCL(CL,DAT) ; -- are clinic stop codes exempt from classifications
97 ; -- 1=yes, 0=no
98 ; original logic from exoe^sdcou2 except uses clinic stops rather
99 ; than outpatient encounter stops
100 ;
101 N SC1,SC2,EXMPT
102 S SC1=$P($G(^SC(CL,0)),"^",7),SC2=$P($G(^SC(CL,0)),"^",18)
103 I $$EX^SDCOU2(SC1,$G(DAT)) D
104 .S EXMPT=1
105 .I SC2,'$$EX^SDCOU2(SC2,$G(DAT)) S EXMPT=0
106EXCLQ Q +$G(EXMPT)
107 ;
108WRITE(SDOE,CNT) ; -- print checkout interview
109 W !?3,"Check out interview..."
110 S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE)
111 I X<1 W $S(X=0:"no questions.",1:"already complete.") G WRITEQ
112 W "required."
113 G:$D(IBDCO)'>1 WRITEQ
114 ;D:$G(CNT)="" DISP
115 D:$G(CNT)'="" LIST
116 ;
117WRITEQ Q
118 ;
119DISP ; -- display the old way
120 I $D(IBDCO("CO")) W !," Checkout Date: ",$$FMTE^XLFDT(IBDCO("CO"))
121 I $D(IBDCO("SC")) W !," Treatment for SC Condition: ",$S(IBDCO("SC")=1:"YES",1:"NO")
122 I $D(IBDCO("AO")) W !," Agent Orange Exposure: ",$S(IBDCO("AO")=1:"YES",1:"NO")
123 I $D(IBDCO("IR")) W !," Ionizing Radiation Exposure: ",$S(IBDCO("IR")=1:"YES",1:"NO")
124 I $D(IBDCO("EC")) W !," Environmental Contaminants: ",$S(IBDCO("EC")=1:"YES",1:"NO")
125 I $D(IBDCO("MST")) W !," MST: ",$S(IBDCO("MST")=1:"YES",1:"NO")
126 Q
127 ;
128LIST ; -- display with a list
129 I $D(IBDCO("CO")) S CNT=CNT+1 W !?3,CNT,?7,"Checkout Date ",?31,$$FMTE^XLFDT(IBDCO("CO"))
130 I $D(IBDCO("SC")) S CNT=CNT+1 W !?3,CNT,?7,"SC Condition ",?31,$S(IBDCO("SC")=1:"YES",1:"NO")
131 I $D(IBDCO("AO")) S CNT=CNT+1 W !?3,CNT,?7,"Agent Orange ",?31,$S(IBDCO("AO")=1:"YES",1:"NO")
132 I $D(IBDCO("IR")) S CNT=CNT+1 W !?3,CNT,?7,"Ionizing Radiation ",?31,$S(IBDCO("IR")=1:"YES",1:"NO")
133 I $D(IBDCO("EC")) S CNT=CNT+1 W !?3,CNT,?7,"Env. Contaminants ",?31,$S(IBDCO("EC")=1:"YES",1:"NO")
134 I $D(IBDCO("MST")) S CNT=CNT+1 W !?3,CNT,?7,"MST ",?31,$S(IBDCO("MST")=1:"YES",1:"NO")
135 Q
Note: See TracBrowser for help on using the repository browser.