source: FOIAVistA/tag/r/EVENT_CAPTURE-EC--ECT--ECX/ECMUTL1.m@ 628

ECMUTL1 ;ALB/ESD - Utilities for Multiple Dates/Mult Procs ;20 AUG 1997 13:56
 ;;2.0; EVENT CAPTURE ;**5,10,15,13,17,23,41,42,50,54**;8 May 96
 ;
 ;
ASKPAT(ECPAT) ; Ask patient
 ;
 ;      Input:  ECPAT = patient DFN and name (passed by reference)
 ;
 ;     Output:      1 = successful
 ;                 -1 = unsuccessful (timed out or uparrowed)
 ;                 -2 = unsuccessful (returned out)
 ;
 N DIC,DUOUT,DTOUT,Y,YY,ECDUP,ECI,ECUP
SEL ;
 S (ECDUP,ECI)=0
 S DIC="^DPT(",DIC(0)="QEAMZ"
 S DIC("A")="Select Patient: "
 D ^DIC
 I Y=-1!($D(DUOUT))!($D(DTOUT)) G ASKPATQ
 ;
 ;- Create ECPLST local array to track duplicate names
 I $O(^TMP("ECPLST",$J,0)) D
 . F  S ECI=$O(^TMP("ECPLST",$J,ECI)) Q:'ECI  D
 .. I +$G(^TMP("ECPLST",$J,ECI))=+Y D
 ... S ECDUP=1
 ... W !!,"Patient already selected.  Please select another patient.",!
 I ECDUP G SEL
 I 'ECDUP D  I $G(ECUP)="^" G SEL
 . S ECPAT=+Y_"^"_$P(Y,"^",2)
 . S YY=Y,DFN=+Y,ECUP="" D 2^VADPT S Y=YY I +VADM(6) D  I ECUP="^" Q
 .. ;NOIS MWV-0603-21781: line below changed by VMP.
 .. W !!,"WARNING "_"[PATIENT DIED ON "_$P(VADM(6),U,2)_"] ",!!
 .. R "Press Return to Continue or ^ to Deselect: ",ECUP:DTIME
 . S ^TMP("ECPLST",$J,($S('$O(^TMP("ECPLST",$J,0)):1,1:$O(^TMP("ECPLST",$J,""),-1)+1)))=+Y_"^"_$P(Y,"^",2)
ASKPATQ Q $S((Y=-1)&($D(DUOUT)!$D(DTOUT)):-1,(Y=-1)&('$D(DUOUT))&('$D(DTOUT)):-2,1:1)
 ;
 ;
ASKORD() ; Ask ordering section
 ;
 ;      Input:   None
 ;
 ;     Output:   Ordering Section ien if successful
 ;               0 if not successful
 ;
 N DIR,DIRUT,Y,ECORD
 S ECORD=0
 S DIR(0)="721,11",DIR("A")="Ordering Section"
 D ^DIR
 I Y=""!($D(DIRUT)) G ASKORDQ
 S ECORD=+Y
ASKORDQ Q +ECORD
 ;
 ;
PCEDAT(ECUNIT,ECSCR,ECPCE) ;get needed PCE data
 ;
 ;   input
 ;   ECUNIT = ien of DSS unit in file #724 (required)
 ;   ECSCR = ien of event code screen in file #720.3 (required);
 ;           but may be null value
 ;   ECPCE  = array, passed by reference (required)
 ;
 ;   output
 ;   ECPCE("CLIN") = associated clinic ien in file #44^clinic name
 ;   ECPCE("DX")   = ien in file #80^icd code
 ;   ECPCE("DXS",) = array of multiple secondary diagnosis, where
 ;                 = ecpce("dxs",n)=v n=dx code and v=dx ien
 ;   ECPCE("AO")   = agent orange indicator
 ;   ECPCE("IR")   = ionizing radiation indicator
 ;   ECPCE("ENV")  = environmental contaminants indicator
 ;   ECPCE("SC")   = service connected indicator (Y/N)
 ;   ECPCE("MST")  = military sexual trauma indicator (Y/N)
 ;   ECPCE("HNC")  = head/neck cancer indicator (Y/N)
 ;   ECPCE("CV")   = combat veteran indicator (Y/N
 ;
 ;   returns
 ;   ECOUT  = if normal user input, then "0"
 ;            if user times-out, then "1"
 ;            if user up-arrows out, then "2"
 ;
 N SEND,ECOUT,EC4,EC4N,ECPCL,ECPCID,ECPCRD
 S ECOUT=0
 S ECSCR=+$G(ECSCR)
 S SEND=$P(^ECD(+ECUNIT,0),"^",14)
 I SEND="" S SEND="N"
 S ECPCE("CLIN")="",ECPCE("DX")="",ECPCE("AO")="",ECPCE("IR")=""
 S ECPCE("ENV")="",ECPCE("SC")="",ECPCE("MST")="",ECPCE("HNC")=""
 S ECPCE("CV")=""
 K ECPCE("DXS")
 I "AO"[SEND D
 .;- Don't write message if Send to PCE = "O" and patient is an inpatient
 .I SEND="A"!(SEND="O"&(ECPCE("I/O")="O")) D
 ..W !!,?5,"Please Note: The following prompt(s) cannot be by-passed with"
 ..W !,?5,"<cr>, since the data is sent to PCE for workload reporting."
 ..W !,?5,"If data cannot be provided, respond with ""^"".  This will"
 ..W !,?5,"remove the current patient from the selected patient list.",!
 .D CLINIC I $G(ECOUT) D MSGCLN Q
 .D ASKDX I $G(ECOUT) D MSGDX Q
 .D VISIT I $G(ECOUT) D CLMSG Q
 I ECSCR,(ECPCE("CLIN")=""),('$G(ECOUT)) D
 .Q:'$D(^ECJ(ECSCR))
 .I ECUNIT'=$P($P(^ECJ(ECSCR,0),"^",1),"-",2) Q
 .S EC4=$P($G(^ECJ(ECSCR,"PRO")),"^",4) I +EC4 D
 ..S EC4N=$P($G(^SC(+EC4,0)),"^",1)
 ..D CLIN(EC4,.ECPCL)
 ..S:ECPCL ECPCE("CLIN")=EC4_"^"_EC4N
 ..S:'ECPCL ECPCE("CLIN")=""
 Q ECOUT
 ;
ASKDX ;ask dx
 N ECDX,ECDXN,DTOUT,DUOUT,DIRUT,DIR,Y,EC4,ECDXS
 S (ECDX,ECDXN)="",EC4=$P(ECPCE("CLIN"),U)
 D PDX^ECUTL2 I ECOUT Q
 S ECPCE("DX")=ECDX_"^"_ECDXN
 D SDX^ECUTL2 I ECOUT Q
 M ECPCE("DXS")=ECDXS
 Q
 ;
CLINIC ;get associated clinic
 N ECDATA,EC4,EC4N,ECID,ECPCL,DTOUT,DUOUT,DIRUT,DIR,Y
 Q:SEND="O"&(ECPCE("I/O")'="O")
 F  D  Q:$G(ECOUT)  Q:$G(ECPCL) 
 .K DA,DIR,DIRUT,DTOUT,DUOUT
 .S (EC4,ECPCL)=0,EC4N=""
 .S DIR(0)="721,26",DIR("A")="Associated Clinic",DIR("?")="An active clinic is required. Enter an active clinic or an ^ to exit"
 .D ^DIR
 .S:$D(DTOUT) ECOUT=1 S:$D(DUOUT) ECOUT=2
 .Q:$G(ECOUT)
 .I 'Y W !!?5,"You must enter an active clinic now.",! Q
 .I Y S EC4=+Y,ECDATA=$G(^SC(+EC4,0)),ECID=$P(ECDATA,"^",7),EC4N=$P(ECDATA,"^",1)
 .I $G(EC4) D CLIN(EC4,.ECPCL) I 'ECPCL D
 ..W !!,?5,"The clinic you selected is inactive."
 ..W !,?5,"Workload data cannot be sent to PCE for Event"
 ..W !,?5,"Capture procedures without an active clinic."
 .I 'ECPCL W !!?5,"You must enter an active clinic now.",!
 Q:'$G(ECPCL)
 S ECPCE("CLIN")=EC4_"^"_EC4N
 Q
 ;
 ;
VISIT ;ask visit info
 N ECFLG,ECCLFLDS,ECCLVAR,ECX,ECAO,ECIR,ECMST,ECMST,ECSC,ECZEC,ECHNC,ECCV
 N ECMDT,ECY,ECMD,ECDT
 Q:ECPCE("I/O")="I"
 S (ECAO,ECIR,ECSC,ECZEC,ECX,ECMST,ECHNC,ECCV)="",ECY=0
 F  S ECY=$O(^TMP("ECMPIDX",$J,ECY)) Q:'ECY  S ECMD=^(ECY) I $P(ECMD,U,2) D
 .S ECMDT($P(ECMD,U,2))=""
 S ECDT=$O(ECMDT(0)) ;use earliest date to evaluate classifications
 ;
 ;- Ask classification questions applicable to patient and file in #721
 I $$ASKCLASS^ECUTL1(+$G(ECPAT),.ECCLFLDS,.ECOUT,SEND,ECPCE("I/O")),($O(ECCLFLDS(""))]"") D SETCLASS^ECUTL1(.ECCLFLDS)
 Q:+$G(ECOUT)
 ;
 ;- Store classification variables into ECPCE array
 F ECCLVAR="ECAO","ECIR","ECZEC","ECSC","ECMST","ECHNC","ECCV" I @($G(ECCLVAR))]"" S ECPCE($S($E(ECCLVAR,3,$L(ECCLVAR))'="ZEC":$E(ECCLVAR,3,$L(ECCLVAR)),1:"ENV"))=@ECCLVAR
 Q
 ;
 ;
CLIN(EC4,ECPCL) ;check for active associated clinic
 N ECPCID,ECPCRD
 D CLIN^ECPCEU
 Q
 ;
 ;
MSGDX ;if ecout & essential data missing, display msg
 Q:SEND="N"  Q:SEND="O"&(ECPCE("I/O")'="O")
 I ECPCE("DX")="" D  Q
 .W !!,?5,"Please note that data cannot be sent to PCE"
 .W !,?5,"for workload reporting without an ICD-9 code.",!
 .D MSG1
 Q
 ;
MSGCLN ;if ecout & essential data missing, display msg
 Q:SEND="N"  Q:SEND="O"&(ECPCE("I/O")'="O")
 I ECPCE("CLIN")="" D  Q
 .W !!,?5,"Please note that data cannot be sent to PCE for workload"
 .W !,?5,"reporting without an active associated clinic.",!
 .D MSG1
 Q
 ;
CLMSG ; Display classification questions error message
 Q:SEND="N"  Q:ECPCE("I/O")'="O"
 W !!,?5,"Please note that data cannot be sent to PCE for workload reporting"
 W !,?5,"unless the classification questions are answered.",!
 D MSG1
 Q
 ;
 ;
MSG1 ;Error message display
 N DIR,Y
 S DIR(0)="E",DIR("A")="Press RETURN to continue"
 D ^DIR
 W !
 Q
 ;
 ;
INOUT(ECPTIEN,ECARRY) ; Determine inpatient/outpatient status
 ;
 N ECOUT
 S ECOUT=0
 S ECARRY=$G(ECARRY)
 S ECPTIEN=+$G(ECPTIEN)
 ;
 ; - If ECARRY not defined, use ^TMP("ECMPIDX",$J)
 S:(ECARRY="") ECARRY="^TMP(""ECMPIDX"",$J)"
 ;
 S ECPCE("I/O")=$$INOUTPT^ECUTL0(ECPTIEN,+$P(@ECARRY@(+$O(@ECARRY@(""),-1)),"^",2))
 I ECPCE("I/O")="" D INOUTERR^ECUTL0
 Q $S(+$G(ECOUT)=0:1,1:0)
 ;
 ;
ASKELIG(ECDSS,ECIO,ECPTIEN) ; Determine patient eligibility
 ;
 ;   Input:
 ;      ECDSS - DSS Unit IEN
 ;      ECIO - Inpatient or Outpatient
 ;      ECPTIEN - DFN of Patient file (#2)
 ;
 ;  Output:
 ;      ECPCE("ELIG") - containing patient eligibility
 ;
 N VAEL
 S ECDSS=+$G(ECDSS)
 S ECIO=$G(ECIO)
 S ECPTIEN=+$G(ECPTIEN)
 ;
 ;- Get elig if Send to PCE="A" or Send to PCE="O" and outpatient
 I $$CHKDSS^ECUTL0(+$G(ECDSS),ECIO) D
 . ;
 . ;- If dual elig, ask user to select otherwise use primary elig
 . I $$MULTELG^ECUTL0(+$G(ECPTIEN)) S ECPCE("ELIG")=+$$ELGLST^ECUTL0
 . E  S ECPCE("ELIG")=+$G(VAEL(1))
 Q
 ;
REMOVE(ECPAT) ; Remove patient from selected patient list because required data missing
 N DFN,ECI
 S DFN=+ECPAT,ECI=0
 F  S ECI=$O(^TMP("ECPLST",$J,ECI)) Q:'ECI  D
 .I +$G(^TMP("ECPLST",$J,ECI))=DFN D
 ..K ^TMP("ECPLST",$J,ECI),^TMP("ECMPTIDX",$J,ECI),^TMP("ECPAT",$J,DFN)
 ..W !?5,"Patient deselected because required data missing.",!
 ..D MSG1
 Q