IBDFDE0 ;ALB/AAS - AICS Data Entry, Check out interview; 24-FEB-96
;;3.0;AUTOMATED INFO COLLECTION SYS;**29,36,44**;APR 24, 1997
;
% G ^IBDFDE
;
CHKOUT(SDOE) ; -- ask check out questions
; -- assumes forms are always for an appointment
; does not require provider, cpt, or diag. to input data
; acts same as input from scanned form.
;
S IBQUIT=0
W !!,">>> Check out interview..."
;
; -- can't check out future appointments
I $E(IBDF("APPT"),1,7)>DT W "not available at this time." G CHKOUTQ
;
; -- get encounter if not already there (won't work unless appt exists)
;I 'SDOE S SDOE=$$GETAPT(DFN,IBDF("APPT"),IBDF("CLINIC"))
;
; -- see if already done, or needs to be done first
S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE,$G(IBDCKOUT))
I X<1 W $S(X=0:"no questions.",X=-2:"not required",X=-3:"already completed today",1:"already complete.") G CHKOUTQ
W "required."
;
; -- ask eligibility/appt type ;not unless asked for
;S ELIG=$$ELAP^SDPCE(DFN,IBDF("APPT"))
;
; -- ask checkout Date
S IBDPRE=$G(IBDCO("CO"))
S X=$S($G(IBDCO("CO"))="":"NOW",1:$$FMTE^XLFDT(IBDCO("CO")))
S IBDCO("CO")=$E($$ASKDT("Checkout Date: ",X,"",IBDF("APPT"),$$FMADD^XLFDT(DT,1)),1,12)
I $G(IBDCO("CO"))="" K IBDCO W " Checkout Deleted!" G CHKOUTQ
I $G(IBDCO("CO"))<0 K:IBDPRE="" IBDCO("CO") W:IBDPRE="" " Checkout Deleted!" S:IBDPRE IBDCO("CO")=IBDPRE S IBQUIT=1 G CHKOUTQ
;
; -- ask classifications
I $$SC^SDCO22(DFN,+SDOE)!($D(IBDF("SC"))) S IBDCO("SC")=$$ASKYN("Was treatment for SC Condition",$G(IBDCO("SC")),"D SCCOND^IBDFN4") D
.I $G(IBDCO("SC"))="" K IBDCO("SC") W " Deleted!"
I $G(IBDCO("SC"))<0 K IBDCO("SC") S IBQUIT=1 G CHKOUTQ
;
I $G(IBDCO("SC")) G MST ; if service connected others don't apply
;
I $$AO^SDCO22(DFN,+SDOE)!($D(IBDF("AO"))) S IBDCO("AO")=$$ASKYN("Was treatment related to Agent Orange Exposure",$G(IBDCO("AO"))) D
.I $G(IBDCO("AO"))="" K IBDCO("AO") W " Deleted!"
I $G(IBDCO("AO"))<0 K IBDCO("AO") S IBQUIT=1 G CHKOUTQ
;
I $$IR^SDCO22(DFN,+SDOE)!($D(IBDF("IR"))) S IBDCO("IR")=$$ASKYN("Was treatment related to Ionizing Radiation Exposure",$G(IBDCO("IR"))) D
.I $G(IBDCO("IR"))="" K IBDCO("IR") W " Deleted!"
I $G(IBDCO("IR"))<0 K IBDCO("IR") S IBQUIT=1 G CHKOUTQ
;
I $$EC^SDCO22(DFN,+SDOE)!($D(IBDF("EC"))) S IBDCO("EC")=$$ASKYN("Was treatment related to Environmental Contaminant Exposure",$G(IBDCO("EC"))) D
.I $G(IBDCO("EC"))="" K IBDCO("EC") W " Deleted!"
I $G(IBDCO("EC"))<0 K IBDCO("EC") S IBQUIT=1 G CHKOUTQ
;
MST ;- Ask Military Sexual Trauma question (patch IBD*3*36)
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
.I $G(IBDCO("MST"))="" K IBDCO("MST") W " Deleted!"
I $G(IBDCO("MST"))<0 K IBDCO("MST") S IBQUIT=1 G CHKOUTQ
;
I '$D(IBDCO) W "no questions."
CHKOUTQ I IBQUIT W !!,"Required information missing."
K IBDPRE,SDFN
Q
;
ASKYN(QUES,DEFLT,EXHELP) ; -- ask yes/no question
N DIR,DIRUT,DUOUT,DTOUT
I $G(EXHELP)'="" S DIR("??")="^"_EXHELP
S DIR("A")=QUES,DIR(0)="YO",DIR("B")=$S($G(DEFLT):"Yes",1:"No") D ^DIR
I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
Q Y
;
ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,EXHELP) ; -- ask date questions
N X,Y,DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="DOA^"_$E($G(EARLY),1,7)_":"_$G(LATEST)_":"_$S($G(PARAM)'="":PARAM,1:"AERX")
I $G(QUES)'="" S DIR("A")=QUES
I $G(DEFLT)'="" S DIR("B")=DEFLT
I $L($G(EXHELP)) S DIR("??")="^"_EXHELP
S DIR("?")="This response requires an appointment Date and Time"
D ^DIR
I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
Q Y
;
REQ(DFN,APPT,CLINIC,SDOE,IBDC) ; is checkout interview required for this appt.
N IBDY S IBDY=0
I $$INP^SDAM2(DFN,APPT)="I" G REQQ ; inpatient appointment
I '$$CLINIC^SDAMU(CLINIC) G REQQ ; not a clinic or non-count
I $$REQ^SDM1A(APPT)'="CO" G REQQ ; checkout not required
I $$EXCL(CLINIC,APPT) S IBDY=-2 G REQQ ; clinic stop codes are exempt
I $$COMDT^SDCOU(+SDOE) S IBDY=-1 G REQQ ;process completed
I $P($G(IBDC),".")=DT S IBDY=-3 G REQQ ;already checked out today
S IBDY=1
REQQ K SDFN
Q IBDY
;
EXCL(CL,DAT) ; -- are clinic stop codes exempt from classifications
; -- 1=yes, 0=no
; original logic from exoe^sdcou2 except uses clinic stops rather
; than outpatient encounter stops
;
N SC1,SC2,EXMPT
S SC1=$P($G(^SC(CL,0)),"^",7),SC2=$P($G(^SC(CL,0)),"^",18)
I $$EX^SDCOU2(SC1,$G(DAT)) D
.S EXMPT=1
.I SC2,'$$EX^SDCOU2(SC2,$G(DAT)) S EXMPT=0
EXCLQ Q +$G(EXMPT)
;
WRITE(SDOE,CNT) ; -- print checkout interview
W !?3,"Check out interview..."
S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE)
I X<1 W $S(X=0:"no questions.",1:"already complete.") G WRITEQ
W "required."
G:$D(IBDCO)'>1 WRITEQ
;D:$G(CNT)="" DISP
D:$G(CNT)'="" LIST
;
WRITEQ Q
;
DISP ; -- display the old way
I $D(IBDCO("CO")) W !," Checkout Date: ",$$FMTE^XLFDT(IBDCO("CO"))
I $D(IBDCO("SC")) W !," Treatment for SC Condition: ",$S(IBDCO("SC")=1:"YES",1:"NO")
I $D(IBDCO("AO")) W !," Agent Orange Exposure: ",$S(IBDCO("AO")=1:"YES",1:"NO")
I $D(IBDCO("IR")) W !," Ionizing Radiation Exposure: ",$S(IBDCO("IR")=1:"YES",1:"NO")
I $D(IBDCO("EC")) W !," Environmental Contaminants: ",$S(IBDCO("EC")=1:"YES",1:"NO")
I $D(IBDCO("MST")) W !," MST: ",$S(IBDCO("MST")=1:"YES",1:"NO")
Q
;
LIST ; -- display with a list
I $D(IBDCO("CO")) S CNT=CNT+1 W !?3,CNT,?7,"Checkout Date ",?31,$$FMTE^XLFDT(IBDCO("CO"))
I $D(IBDCO("SC")) S CNT=CNT+1 W !?3,CNT,?7,"SC Condition ",?31,$S(IBDCO("SC")=1:"YES",1:"NO")
I $D(IBDCO("AO")) S CNT=CNT+1 W !?3,CNT,?7,"Agent Orange ",?31,$S(IBDCO("AO")=1:"YES",1:"NO")
I $D(IBDCO("IR")) S CNT=CNT+1 W !?3,CNT,?7,"Ionizing Radiation ",?31,$S(IBDCO("IR")=1:"YES",1:"NO")
I $D(IBDCO("EC")) S CNT=CNT+1 W !?3,CNT,?7,"Env. Contaminants ",?31,$S(IBDCO("EC")=1:"YES",1:"NO")
I $D(IBDCO("MST")) S CNT=CNT+1 W !?3,CNT,?7,"MST ",?31,$S(IBDCO("MST")=1:"YES",1:"NO")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFDE0 6143 printed Oct 16, 2024@18:52:57 Page 2
IBDFDE0 ;ALB/AAS - AICS Data Entry, Check out interview; 24-FEB-96
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**29,36,44**;APR 24, 1997
+2 ;
% GOTO ^IBDFDE
+1 ;
CHKOUT(SDOE) ; -- ask check out questions
+1 ; -- assumes forms are always for an appointment
+2 ; does not require provider, cpt, or diag. to input data
+3 ; acts same as input from scanned form.
+4 ;
+5 SET IBQUIT=0
+6 WRITE !!,">>> Check out interview..."
+7 ;
+8 ; -- can't check out future appointments
+9 IF $EXTRACT(IBDF("APPT"),1,7)>DT
WRITE "not available at this time."
GOTO CHKOUTQ
+10 ;
+11 ; -- get encounter if not already there (won't work unless appt exists)
+12 ;I 'SDOE S SDOE=$$GETAPT(DFN,IBDF("APPT"),IBDF("CLINIC"))
+13 ;
+14 ; -- see if already done, or needs to be done first
+15 SET X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE,$GET(IBDCKOUT))
+16 IF X<1
WRITE $SELECT(X=0:"no questions.",X=-2:"not required",X=-3:"already completed today",1:"already complete.")
GOTO CHKOUTQ
+17 WRITE "required."
+18 ;
+19 ; -- ask eligibility/appt type ;not unless asked for
+20 ;S ELIG=$$ELAP^SDPCE(DFN,IBDF("APPT"))
+21 ;
+22 ; -- ask checkout Date
+23 SET IBDPRE=$GET(IBDCO("CO"))
+24 SET X=$SELECT($GET(IBDCO("CO"))="":"NOW",1:$$FMTE^XLFDT(IBDCO("CO")))
+25 SET IBDCO("CO")=$EXTRACT($$ASKDT("Checkout Date: ",X,"",IBDF("APPT"),$$FMADD^XLFDT(DT,1)),1,12)
+26 IF $GET(IBDCO("CO"))=""
KILL IBDCO
WRITE " Checkout Deleted!"
GOTO CHKOUTQ
+27 IF $GET(IBDCO("CO"))<0
if IBDPRE=""
KILL IBDCO("CO")
if IBDPRE=""
WRITE " Checkout Deleted!"
if IBDPRE
SET IBDCO("CO")=IBDPRE
SET IBQUIT=1
GOTO CHKOUTQ
+28 ;
+29 ; -- ask classifications
+30 IF $$SC^SDCO22(DFN,+SDOE)!($DATA(IBDF("SC")))
SET IBDCO("SC")=$$ASKYN("Was treatment for SC Condition",$GET(IBDCO("SC")),"D SCCOND^IBDFN4")
Begin DoDot:1
+31 IF $GET(IBDCO("SC"))=""
KILL IBDCO("SC")
WRITE " Deleted!"
End DoDot:1
+32 IF $GET(IBDCO("SC"))<0
KILL IBDCO("SC")
SET IBQUIT=1
GOTO CHKOUTQ
+33 ;
+34 ; if service connected others don't apply
IF $GET(IBDCO("SC"))
GOTO MST
+35 ;
+36 IF $$AO^SDCO22(DFN,+SDOE)!($DATA(IBDF("AO")))
SET IBDCO("AO")=$$ASKYN("Was treatment related to Agent Orange Exposure",$GET(IBDCO("AO")))
Begin DoDot:1
+37 IF $GET(IBDCO("AO"))=""
KILL IBDCO("AO")
WRITE " Deleted!"
End DoDot:1
+38 IF $GET(IBDCO("AO"))<0
KILL IBDCO("AO")
SET IBQUIT=1
GOTO CHKOUTQ
+39 ;
+40 IF $$IR^SDCO22(DFN,+SDOE)!($DATA(IBDF("IR")))
SET IBDCO("IR")=$$ASKYN("Was treatment related to Ionizing Radiation Exposure",$GET(IBDCO("IR")))
Begin DoDot:1
+41 IF $GET(IBDCO("IR"))=""
KILL IBDCO("IR")
WRITE " Deleted!"
End DoDot:1
+42 IF $GET(IBDCO("IR"))<0
KILL IBDCO("IR")
SET IBQUIT=1
GOTO CHKOUTQ
+43 ;
+44 IF $$EC^SDCO22(DFN,+SDOE)!($DATA(IBDF("EC")))
SET IBDCO("EC")=$$ASKYN("Was treatment related to Environmental Contaminant Exposure",$GET(IBDCO("EC")))
Begin DoDot:1
+45 IF $GET(IBDCO("EC"))=""
KILL IBDCO("EC")
WRITE " Deleted!"
End DoDot:1
+46 IF $GET(IBDCO("EC"))<0
KILL IBDCO("EC")
SET IBQUIT=1
GOTO CHKOUTQ
+47 ;
MST ;- Ask Military Sexual Trauma question (patch IBD*3*36)
+1 IF $$MST^SDCO22(DFN,+SDOE)!($DATA(IBDF("MST")))
SET IBDCO("MST")=$$ASKYN("Was treatment related to MST (Note: ask provider only)",$GET(IBDCO("MST")))
Begin DoDot:1
+2 IF $GET(IBDCO("MST"))=""
KILL IBDCO("MST")
WRITE " Deleted!"
End DoDot:1
+3 IF $GET(IBDCO("MST"))<0
KILL IBDCO("MST")
SET IBQUIT=1
GOTO CHKOUTQ
+4 ;
+5 IF '$DATA(IBDCO)
WRITE "no questions."
CHKOUTQ IF IBQUIT
WRITE !!,"Required information missing."
+1 KILL IBDPRE,SDFN
+2 QUIT
+3 ;
ASKYN(QUES,DEFLT,EXHELP) ; -- ask yes/no question
+1 NEW DIR,DIRUT,DUOUT,DTOUT
+2 IF $GET(EXHELP)'=""
SET DIR("??")="^"_EXHELP
+3 SET DIR("A")=QUES
SET DIR(0)="YO"
SET DIR("B")=$SELECT($GET(DEFLT):"Yes",1:"No")
DO ^DIR
+4 ;i y="" user typed "@"
IF $DATA(DIRUT)
IF Y'=""
SET Y=-1
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBQUIT=1
SET Y=-1
+6 QUIT Y
+7 ;
ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,EXHELP) ; -- ask date questions
+1 NEW X,Y,DIR,DIRUT,DTOUT,DUOUT
+2 SET DIR(0)="DOA^"_$EXTRACT($GET(EARLY),1,7)_":"_$GET(LATEST)_":"_$SELECT($GET(PARAM)'="":PARAM,1:"AERX")
+3 IF $GET(QUES)'=""
SET DIR("A")=QUES
+4 IF $GET(DEFLT)'=""
SET DIR("B")=DEFLT
+5 IF $LENGTH($GET(EXHELP))
SET DIR("??")="^"_EXHELP
+6 SET DIR("?")="This response requires an appointment Date and Time"
+7 DO ^DIR
+8 ;i y="" user typed "@"
IF $DATA(DIRUT)
IF Y'=""
SET Y=-1
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBQUIT=1
SET Y=-1
+10 QUIT Y
+11 ;
REQ(DFN,APPT,CLINIC,SDOE,IBDC) ; is checkout interview required for this appt.
+1 NEW IBDY
SET IBDY=0
+2 ; inpatient appointment
IF $$INP^SDAM2(DFN,APPT)="I"
GOTO REQQ
+3 ; not a clinic or non-count
IF '$$CLINIC^SDAMU(CLINIC)
GOTO REQQ
+4 ; checkout not required
IF $$REQ^SDM1A(APPT)'="CO"
GOTO REQQ
+5 ; clinic stop codes are exempt
IF $$EXCL(CLINIC,APPT)
SET IBDY=-2
GOTO REQQ
+6 ;process completed
IF $$COMDT^SDCOU(+SDOE)
SET IBDY=-1
GOTO REQQ
+7 ;already checked out today
IF $PIECE($GET(IBDC),".")=DT
SET IBDY=-3
GOTO REQQ
+8 SET IBDY=1
REQQ KILL SDFN
+1 QUIT IBDY
+2 ;
EXCL(CL,DAT) ; -- are clinic stop codes exempt from classifications
+1 ; -- 1=yes, 0=no
+2 ; original logic from exoe^sdcou2 except uses clinic stops rather
+3 ; than outpatient encounter stops
+4 ;
+5 NEW SC1,SC2,EXMPT
+6 SET SC1=$PIECE($GET(^SC(CL,0)),"^",7)
SET SC2=$PIECE($GET(^SC(CL,0)),"^",18)
+7 IF $$EX^SDCOU2(SC1,$GET(DAT))
Begin DoDot:1
+8 SET EXMPT=1
+9 IF SC2
IF '$$EX^SDCOU2(SC2,$GET(DAT))
SET EXMPT=0
End DoDot:1
EXCLQ QUIT +$GET(EXMPT)
+1 ;
WRITE(SDOE,CNT) ; -- print checkout interview
+1 WRITE !?3,"Check out interview..."
+2 SET X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE)
+3 IF X<1
WRITE $SELECT(X=0:"no questions.",1:"already complete.")
GOTO WRITEQ
+4 WRITE "required."
+5 if $DATA(IBDCO)'>1
GOTO WRITEQ
+6 ;D:$G(CNT)="" DISP
+7 if $GET(CNT)'=""
DO LIST
+8 ;
WRITEQ QUIT
+1 ;
DISP ; -- display the old way
+1 IF $DATA(IBDCO("CO"))
WRITE !," Checkout Date: ",$$FMTE^XLFDT(IBDCO("CO"))
+2 IF $DATA(IBDCO("SC"))
WRITE !," Treatment for SC Condition: ",$SELECT(IBDCO("SC")=1:"YES",1:"NO")
+3 IF $DATA(IBDCO("AO"))
WRITE !," Agent Orange Exposure: ",$SELECT(IBDCO("AO")=1:"YES",1:"NO")
+4 IF $DATA(IBDCO("IR"))
WRITE !," Ionizing Radiation Exposure: ",$SELECT(IBDCO("IR")=1:"YES",1:"NO")
+5 IF $DATA(IBDCO("EC"))
WRITE !," Environmental Contaminants: ",$SELECT(IBDCO("EC")=1:"YES",1:"NO")
+6 IF $DATA(IBDCO("MST"))
WRITE !," MST: ",$SELECT(IBDCO("MST")=1:"YES",1:"NO")
+7 QUIT
+8 ;
LIST ; -- display with a list
+1 IF $DATA(IBDCO("CO"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"Checkout Date ",?31,$$FMTE^XLFDT(IBDCO("CO"))
+2 IF $DATA(IBDCO("SC"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"SC Condition ",?31,$SELECT(IBDCO("SC")=1:"YES",1:"NO")
+3 IF $DATA(IBDCO("AO"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"Agent Orange ",?31,$SELECT(IBDCO("AO")=1:"YES",1:"NO")
+4 IF $DATA(IBDCO("IR"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"Ionizing Radiation ",?31,$SELECT(IBDCO("IR")=1:"YES",1:"NO")
+5 IF $DATA(IBDCO("EC"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"Env. Contaminants ",?31,$SELECT(IBDCO("EC")=1:"YES",1:"NO")
+6 IF $DATA(IBDCO("MST"))
SET CNT=CNT+1
WRITE !?3,CNT,?7,"MST ",?31,$SELECT(IBDCO("MST")=1:"YES",1:"NO")
+7 QUIT
