- 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 Feb 19, 2025@00:18:37 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