Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFDE0

IBDFDE0.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. % G ^IBDFDE
  1. ;
  1. CHKOUT(SDOE) ; -- ask check out questions
  1. ; -- assumes forms are always for an appointment
  1. ; does not require provider, cpt, or diag. to input data
  1. ; acts same as input from scanned form.
  1. ;
  1. S IBQUIT=0
  1. W !!,">>> Check out interview..."
  1. ;
  1. ; -- can't check out future appointments
  1. I $E(IBDF("APPT"),1,7)>DT W "not available at this time." G CHKOUTQ
  1. ;
  1. ; -- get encounter if not already there (won't work unless appt exists)
  1. ;I 'SDOE S SDOE=$$GETAPT(DFN,IBDF("APPT"),IBDF("CLINIC"))
  1. ;
  1. ; -- see if already done, or needs to be done first
  1. S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE,$G(IBDCKOUT))
  1. I X<1 W $S(X=0:"no questions.",X=-2:"not required",X=-3:"already completed today",1:"already complete.") G CHKOUTQ
  1. W "required."
  1. ;
  1. ; -- ask eligibility/appt type ;not unless asked for
  1. ;S ELIG=$$ELAP^SDPCE(DFN,IBDF("APPT"))
  1. ;
  1. ; -- ask checkout Date
  1. S IBDPRE=$G(IBDCO("CO"))
  1. S X=$S($G(IBDCO("CO"))="":"NOW",1:$$FMTE^XLFDT(IBDCO("CO")))
  1. S IBDCO("CO")=$E($$ASKDT("Checkout Date: ",X,"",IBDF("APPT"),$$FMADD^XLFDT(DT,1)),1,12)
  1. I $G(IBDCO("CO"))="" K IBDCO W " Checkout Deleted!" G CHKOUTQ
  1. I $G(IBDCO("CO"))<0 K:IBDPRE="" IBDCO("CO") W:IBDPRE="" " Checkout Deleted!" S:IBDPRE IBDCO("CO")=IBDPRE S IBQUIT=1 G CHKOUTQ
  1. ;
  1. ; -- ask classifications
  1. I $$SC^SDCO22(DFN,+SDOE)!($D(IBDF("SC"))) S IBDCO("SC")=$$ASKYN("Was treatment for SC Condition",$G(IBDCO("SC")),"D SCCOND^IBDFN4") D
  1. .I $G(IBDCO("SC"))="" K IBDCO("SC") W " Deleted!"
  1. I $G(IBDCO("SC"))<0 K IBDCO("SC") S IBQUIT=1 G CHKOUTQ
  1. ;
  1. I $G(IBDCO("SC")) G MST ; if service connected others don't apply
  1. ;
  1. I $$AO^SDCO22(DFN,+SDOE)!($D(IBDF("AO"))) S IBDCO("AO")=$$ASKYN("Was treatment related to Agent Orange Exposure",$G(IBDCO("AO"))) D
  1. .I $G(IBDCO("AO"))="" K IBDCO("AO") W " Deleted!"
  1. I $G(IBDCO("AO"))<0 K IBDCO("AO") S IBQUIT=1 G CHKOUTQ
  1. ;
  1. I $$IR^SDCO22(DFN,+SDOE)!($D(IBDF("IR"))) S IBDCO("IR")=$$ASKYN("Was treatment related to Ionizing Radiation Exposure",$G(IBDCO("IR"))) D
  1. .I $G(IBDCO("IR"))="" K IBDCO("IR") W " Deleted!"
  1. I $G(IBDCO("IR"))<0 K IBDCO("IR") S IBQUIT=1 G CHKOUTQ
  1. ;
  1. I $$EC^SDCO22(DFN,+SDOE)!($D(IBDF("EC"))) S IBDCO("EC")=$$ASKYN("Was treatment related to Environmental Contaminant Exposure",$G(IBDCO("EC"))) D
  1. .I $G(IBDCO("EC"))="" K IBDCO("EC") W " Deleted!"
  1. I $G(IBDCO("EC"))<0 K IBDCO("EC") S IBQUIT=1 G CHKOUTQ
  1. ;
  1. MST ;- Ask Military Sexual Trauma question (patch IBD*3*36)
  1. 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
  1. .I $G(IBDCO("MST"))="" K IBDCO("MST") W " Deleted!"
  1. I $G(IBDCO("MST"))<0 K IBDCO("MST") S IBQUIT=1 G CHKOUTQ
  1. ;
  1. I '$D(IBDCO) W "no questions."
  1. CHKOUTQ I IBQUIT W !!,"Required information missing."
  1. K IBDPRE,SDFN
  1. Q
  1. ;
  1. ASKYN(QUES,DEFLT,EXHELP) ; -- ask yes/no question
  1. N DIR,DIRUT,DUOUT,DTOUT
  1. I $G(EXHELP)'="" S DIR("??")="^"_EXHELP
  1. S DIR("A")=QUES,DIR(0)="YO",DIR("B")=$S($G(DEFLT):"Yes",1:"No") D ^DIR
  1. I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
  1. I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
  1. Q Y
  1. ;
  1. ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,EXHELP) ; -- ask date questions
  1. N X,Y,DIR,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="DOA^"_$E($G(EARLY),1,7)_":"_$G(LATEST)_":"_$S($G(PARAM)'="":PARAM,1:"AERX")
  1. I $G(QUES)'="" S DIR("A")=QUES
  1. I $G(DEFLT)'="" S DIR("B")=DEFLT
  1. I $L($G(EXHELP)) S DIR("??")="^"_EXHELP
  1. S DIR("?")="This response requires an appointment Date and Time"
  1. D ^DIR
  1. I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
  1. I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
  1. Q Y
  1. ;
  1. REQ(DFN,APPT,CLINIC,SDOE,IBDC) ; is checkout interview required for this appt.
  1. N IBDY S IBDY=0
  1. I $$INP^SDAM2(DFN,APPT)="I" G REQQ ; inpatient appointment
  1. I '$$CLINIC^SDAMU(CLINIC) G REQQ ; not a clinic or non-count
  1. I $$REQ^SDM1A(APPT)'="CO" G REQQ ; checkout not required
  1. I $$EXCL(CLINIC,APPT) S IBDY=-2 G REQQ ; clinic stop codes are exempt
  1. I $$COMDT^SDCOU(+SDOE) S IBDY=-1 G REQQ ;process completed
  1. I $P($G(IBDC),".")=DT S IBDY=-3 G REQQ ;already checked out today
  1. S IBDY=1
  1. REQQ K SDFN
  1. Q IBDY
  1. ;
  1. EXCL(CL,DAT) ; -- are clinic stop codes exempt from classifications
  1. ; -- 1=yes, 0=no
  1. ; original logic from exoe^sdcou2 except uses clinic stops rather
  1. ; than outpatient encounter stops
  1. ;
  1. N SC1,SC2,EXMPT
  1. S SC1=$P($G(^SC(CL,0)),"^",7),SC2=$P($G(^SC(CL,0)),"^",18)
  1. I $$EX^SDCOU2(SC1,$G(DAT)) D
  1. .S EXMPT=1
  1. .I SC2,'$$EX^SDCOU2(SC2,$G(DAT)) S EXMPT=0
  1. EXCLQ Q +$G(EXMPT)
  1. ;
  1. WRITE(SDOE,CNT) ; -- print checkout interview
  1. W !?3,"Check out interview..."
  1. S X=$$REQ(DFN,IBDF("APPT"),IBDF("CLINIC"),SDOE)
  1. I X<1 W $S(X=0:"no questions.",1:"already complete.") G WRITEQ
  1. W "required."
  1. G:$D(IBDCO)'>1 WRITEQ
  1. ;D:$G(CNT)="" DISP
  1. D:$G(CNT)'="" LIST
  1. ;
  1. WRITEQ Q
  1. ;
  1. DISP ; -- display the old way
  1. I $D(IBDCO("CO")) W !," Checkout Date: ",$$FMTE^XLFDT(IBDCO("CO"))
  1. I $D(IBDCO("SC")) W !," Treatment for SC Condition: ",$S(IBDCO("SC")=1:"YES",1:"NO")
  1. I $D(IBDCO("AO")) W !," Agent Orange Exposure: ",$S(IBDCO("AO")=1:"YES",1:"NO")
  1. I $D(IBDCO("IR")) W !," Ionizing Radiation Exposure: ",$S(IBDCO("IR")=1:"YES",1:"NO")
  1. I $D(IBDCO("EC")) W !," Environmental Contaminants: ",$S(IBDCO("EC")=1:"YES",1:"NO")
  1. I $D(IBDCO("MST")) W !," MST: ",$S(IBDCO("MST")=1:"YES",1:"NO")
  1. Q
  1. ;
  1. LIST ; -- display with a list
  1. I $D(IBDCO("CO")) S CNT=CNT+1 W !?3,CNT,?7,"Checkout Date ",?31,$$FMTE^XLFDT(IBDCO("CO"))
  1. I $D(IBDCO("SC")) S CNT=CNT+1 W !?3,CNT,?7,"SC Condition ",?31,$S(IBDCO("SC")=1:"YES",1:"NO")
  1. I $D(IBDCO("AO")) S CNT=CNT+1 W !?3,CNT,?7,"Agent Orange ",?31,$S(IBDCO("AO")=1:"YES",1:"NO")
  1. I $D(IBDCO("IR")) S CNT=CNT+1 W !?3,CNT,?7,"Ionizing Radiation ",?31,$S(IBDCO("IR")=1:"YES",1:"NO")
  1. I $D(IBDCO("EC")) S CNT=CNT+1 W !?3,CNT,?7,"Env. Contaminants ",?31,$S(IBDCO("EC")=1:"YES",1:"NO")
  1. I $D(IBDCO("MST")) S CNT=CNT+1 W !?3,CNT,?7,"MST ",?31,$S(IBDCO("MST")=1:"YES",1:"NO")
  1. Q