| 1 | IBDFDE6 ;ALB/AAS - AICS Manual Data Entry, Entry point by clinic ; 29-APR-96
|
|---|
| 2 | ;;3.0;AUTOMATED INFO COLLECTION SYS;**11,51**;APR 24, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | W !,?4,"** This option is OUT OF ORDER **" QUIT ;Code set Versioning
|
|---|
| 5 | ;
|
|---|
| 6 | % N %,%H,C,I,J,X,Y,ADD,DEL,ASKOTHER,DIR,DIC,DA,CNT,DFN,DIRUT,DUOUT,DTOUT,POP,RTN,FRMDATA,IBY,IBQUIT,IBDF,IBDOBJ,IBDPTSTI,IBDPTSTE,IBDPTNM,IBDPTDTI,SEL,IBD,IBDCKOUT
|
|---|
| 7 | N IBDPTDTE,IBDFMNME,IBDFMIEN,IBDFMSTI,IBDFMSTE,IBDFMIDI,IBDCLNME,IBFORM,IBDCLNPH,IBDPID,IBDPTPRI,IBDSEL,IBDPI,IBDCO,PXCA,SDCLST,PXCASTAT,PXKNODA,PXKNODB,IBDREDIT,IBDASK,IBDPRE,IBDX,ANS,CLNAME,CLSETUP,IBDSC,FORM,FORMLST,IBDFDT,IBD
|
|---|
| 8 | ;
|
|---|
| 9 | I '$D(DT) D DT^DICRW
|
|---|
| 10 | D HOME^%ZIS
|
|---|
| 11 | W !!,"Data Entry of Encounter Forms (by Clinic)",!!
|
|---|
| 12 | ;
|
|---|
| 13 | STRT ; -- ask for Clinic, date then patient.
|
|---|
| 14 | ; Only list patients w/no data entry
|
|---|
| 15 | ; find all forms for appt., then go through 1 at a time
|
|---|
| 16 | ;
|
|---|
| 17 | D END
|
|---|
| 18 | S IBQUIT=0
|
|---|
| 19 | S (IBDSC,IBDF("CLINIC"))=$$SELCL G:IBQUIT STRTQ
|
|---|
| 20 | I IBDSC<1 S IBQUIT=1 G STRTQ
|
|---|
| 21 | S CLNAME=$P($G(^SC(+IBDSC,0)),"^")
|
|---|
| 22 | S CLSETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",+IBDSC,0)),0))
|
|---|
| 23 | ;
|
|---|
| 24 | APPT W ! S IBDFDT=$$SELAP(.IBDF) G:IBQUIT STRTQ
|
|---|
| 25 | I IBDFDT<0 W !! G STRT
|
|---|
| 26 | ;
|
|---|
| 27 | D BLD
|
|---|
| 28 | I '$D(^TMP("IBD-PL",$J,IBDF("CLINIC"))) W !!,"No appointments on that Date!",!! G APPT
|
|---|
| 29 | ;
|
|---|
| 30 | OVER D HDR ;,LIST
|
|---|
| 31 | W !! D SELPT G:IBQUIT STRTQ
|
|---|
| 32 | S IBDF("OPTION")=1
|
|---|
| 33 | I $G(RESULT)="" G APPT
|
|---|
| 34 | I $G(RESULT)=-1 G OVERQ
|
|---|
| 35 | S (DFN,IBDF("DFN"))=+RESULT,IBDF("APPT")=$P(RESULT,"^",2)
|
|---|
| 36 | S FORMLST=$$FINDID^IBDF18C(DFN,IBDF("APPT"),"",1)
|
|---|
| 37 | I FORMLST]"" I IBDF("CLINIC")'=$P(^IBD(357.96,+FORMLST,0),"^",10) S FORMLST=""
|
|---|
| 38 | I FORMLST="" W !,"No forms Printed for Patient" D ANYWAY I IBQUIT G STRTQ
|
|---|
| 39 | I FORMLST="" G OVERQ ;D PAUSE^IBDFDE G OVERQ
|
|---|
| 40 | F IBDX=1:1 S IBDF("FORM")=$P(FORMLST,"^",IBDX) Q:IBDF("FORM")="" I IBDF("FORM")'="" D EN^IBDFDE K IBDSEL,IBDPI Q:IBQUIT
|
|---|
| 41 | W !!
|
|---|
| 42 | ;S IBDF("CLINIC")=IBDSC
|
|---|
| 43 | OVERQ G OVER
|
|---|
| 44 | ;
|
|---|
| 45 | STRTQ ;D PAUSE^IBDFDE
|
|---|
| 46 | G:IBQUIT END
|
|---|
| 47 | G APPT
|
|---|
| 48 | ;
|
|---|
| 49 | ANYWAY ; -- if no forms available ask if want to enter form anyway
|
|---|
| 50 | ; all to use default form, clinic setup,or any form
|
|---|
| 51 | ;
|
|---|
| 52 | N X,Y,DIR,DIRUT
|
|---|
| 53 | S DIR("?")="If you wish to enter data for this patient anyway, chose whether to use the default form, select any form, or use the clinic setup. Answer None if you don't wish to enter any data."
|
|---|
| 54 | S DIR("A")="Enter Data from [A]ny form, [C]linic Setup, [D]efault, [N]one: "
|
|---|
| 55 | S DIR(0)="SA^A:ANYFORM;C:CLINIC SETUP;D:DEFAULT;N:NONE",DIR("B")="CLINIC SETUP"
|
|---|
| 56 | I '$D(CLSETUP),+$G(IBDF("CLINIC")) S CLNAME=$P($G(^SC(+IBDF("CLINIC"),0)),"^"),CLSETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",+IBDF("CLINIC"),0)),0))
|
|---|
| 57 | I CLSETUP="" S DIR("B")="DEFAULT" W !,"No Forms Defined for Clinic"
|
|---|
| 58 | D ^DIR K DIR
|
|---|
| 59 | I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 G ANYWAYQ
|
|---|
| 60 | I $D(DIRUT) G ANYWAYQ
|
|---|
| 61 | S ANS=Y
|
|---|
| 62 | I ANS="N" G ANYWAYQ
|
|---|
| 63 | ;
|
|---|
| 64 | I ANS="D" D G ANYWAYQ
|
|---|
| 65 | .S IBFORM=$P($G(^IBD(357.09,1,0)),"^",4)
|
|---|
| 66 | .I IBFORM="" S IBFORM=$O(^IBE(357,"B","PRIMARY CARE SAMPLE V2.1",0))
|
|---|
| 67 | .S FORMLST=$$OTHFRM(IBFORM)
|
|---|
| 68 | .Q
|
|---|
| 69 | ;
|
|---|
| 70 | I ANS="A" D G ANYWAYQ
|
|---|
| 71 | .S DIC("S")="I $P(^(0),U)'=""GARBAGE"",$P(^(0),U)'=""TOOL KIT"""
|
|---|
| 72 | .S DIC="^IBE(357,",DIC(0)="AEQM" D ^DIC K DIC Q:+Y<1
|
|---|
| 73 | .S IBFORM=+Y
|
|---|
| 74 | .S FORMLST=$$OTHFRM(IBFORM)
|
|---|
| 75 | .Q
|
|---|
| 76 | ;
|
|---|
| 77 | I ANS="C" D G ANYWAYQ
|
|---|
| 78 | .F IBD=2,6,8,9,3,4 S IBFORM=$P(CLSETUP,"^",IBD) I IBFORM W ! S FORMLST=FORMLST_$$OTHFRM(IBFORM)_"^"
|
|---|
| 79 | .I FORMLST="" W !!,"No forms defined for clinic"
|
|---|
| 80 | .Q
|
|---|
| 81 | ANYWAYQ Q
|
|---|
| 82 | ;
|
|---|
| 83 | OTHFRM(IBFORM) ; -- if no form printed, add form tracking entry,
|
|---|
| 84 | ; -- compile form if necessary return form list
|
|---|
| 85 | N FORMID,FORMLST
|
|---|
| 86 | S FORMID=$P($G(^IBE(357,IBFORM,0)),"^",13)
|
|---|
| 87 | I FORMID="" D
|
|---|
| 88 | .W !,"Please wait, Creating the necessary entry..."
|
|---|
| 89 | .L +^IBE(357,IBFORM):1
|
|---|
| 90 | .S FORMID=$$FORMTYPE^IBDF18D(1) W "."
|
|---|
| 91 | .S $P(^IBD(357.95,FORMID,0),"^",21)=IBFORM W "."
|
|---|
| 92 | .S $P(^IBE(357,IBFORM,0),"^",13)=FORMID
|
|---|
| 93 | .S:$P(^IBE(357,IBFORM,0),"^",13) ^IBE(357,"ADEF",$P(^IBE(357,IBFORM,0),"^",13),IBFORM)=""
|
|---|
| 94 | .L -^IBE(357,IBFORM)
|
|---|
| 95 | S FORMLST=+$$FID^IBDF18C(DFN,IBDF("APPT"),1,FORMID,IBDF("CLINIC"))
|
|---|
| 96 | S DIE="^IBD(357.96,",DR=".11////20",DA=FORMLST D ^DIE K DA,DR,DIC,DIE
|
|---|
| 97 | ;
|
|---|
| 98 | Q FORMLST
|
|---|
| 99 | ;
|
|---|
| 100 | SELCL() ; -- select clinic
|
|---|
| 101 | S IBQUIT=0
|
|---|
| 102 | N DIR,DA,DR,DIC,DIE,X,Y,ANS,DIRUT
|
|---|
| 103 | S ANS=-1
|
|---|
| 104 | S DIR("?")="Enter the name of the clinic that you are entering encounter forms for."
|
|---|
| 105 | S DIR("S")="I $P(^(0),U,3)=""C"""
|
|---|
| 106 | S DIR(0)="PO^44:AEQM",DIR("A")="Select Clinic" D ^DIR K DIR,DA,DR,DIC
|
|---|
| 107 | I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 G SELCLQ
|
|---|
| 108 | I $D(DIRUT) G SELCLQ
|
|---|
| 109 | S ANS=+Y
|
|---|
| 110 | SELCLQ Q ANS
|
|---|
| 111 | ;
|
|---|
| 112 | ;
|
|---|
| 113 | SELAP(IBDF) ; -- select appointment date for a clinic
|
|---|
| 114 | S IBQUIT=0
|
|---|
| 115 | N DIR,DA,DR,DIC,DIE,X,Y,ANS,DIRUT
|
|---|
| 116 | S ANS=-1
|
|---|
| 117 | ;I $G(LASTDATE)?7N S DIR("B")=$$FMTE^XLFDT(LASTDATE)
|
|---|
| 118 | ;R !,"Appointment Date: ",X:$G(DTIME)
|
|---|
| 119 | S DIR(0)="DO^:DT:EX",DIR("A")="Appointment Date"
|
|---|
| 120 | S DIR("?")="Enter the date for the clinic that you wish to enter encounter forms for"
|
|---|
| 121 | S DIR("??")="^D APDT^IBDFDE6"
|
|---|
| 122 | D ^DIR K DIR
|
|---|
| 123 | I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 G SELAPQ
|
|---|
| 124 | I $D(DIRUT) G SELAPQ
|
|---|
| 125 | S ANS=+Y
|
|---|
| 126 | SELAPQ Q ANS
|
|---|
| 127 | ;
|
|---|
| 128 | SELPT ; -- select patient(s) to process
|
|---|
| 129 | S IBDCLIN=IBDF("CLINIC") N ARRAY,CNT,IBD K IBDF,IBDCO,PXCA,SEL S IBDF("CLINIC")=IBDCLIN K IBDCLIN
|
|---|
| 130 | S (ARRAY,RESULT,ANS)="",(IBQUIT,CNT)=0
|
|---|
| 131 | S DIR("?")="Enter the listed number or the name of the patient or the last 4 number of the SSN or the first letter of the last name with the last 4 numbers of the SSN."
|
|---|
| 132 | S DIR("??")="^D LIST^IBDFDE6"
|
|---|
| 133 | S DIR(0)="FO^1:30",DIR("A")="Select Patient"
|
|---|
| 134 | D ^DIR K DIR
|
|---|
| 135 | I $D(DUOUT)!($D(DTOUT)) S IBQUIT=1 G SELQ
|
|---|
| 136 | S ANS=$$UP^XLFSTR(Y)
|
|---|
| 137 | I ANS="" G SELQ
|
|---|
| 138 | I $D(DIRUT) S IBQUIT=1 G SELQ
|
|---|
| 139 | I ANS=+ANS S ARRAY="IBD-PL" I $D(^TMP(ARRAY,$J,IBDF("CLINIC"),ANS)) S RESULT=^(ANS) W " ",$P($G(^DPT(+RESULT,0)),"^") G SELQ
|
|---|
| 140 | ;
|
|---|
| 141 | I ANS?4N S ARRAY="IBD-PL4" D ARRAY(ARRAY,ANS) G FIND
|
|---|
| 142 | I ANS?1A4N S ARRAY="IBD-PLB" D ARRAY(ARRAY,ANS) G FIND
|
|---|
| 143 | S ARRAY="IBD-PLN" D ARRAY(ARRAY,ANS) D G FIND
|
|---|
| 144 | .S NAME=ANS F S NAME=$O(^TMP(ARRAY,$J,IBDF("CLINIC"),NAME)) Q:$E(NAME,1,$L(ANS))'=ANS D ARRAY(ARRAY,NAME)
|
|---|
| 145 | G SELQ
|
|---|
| 146 | FIND ;find appropriate pt appt from array
|
|---|
| 147 | I CNT=1 S RESULT=$G(^TMP(ARRAY,$J,IBDF("CLINIC"),$P(IBD(CNT),"^",2),+IBD(CNT))) D:$D(RESULT) G SELQ
|
|---|
| 148 | .I ARRAY="IBD-PLN" W " ",$E($P($G(^DPT(+RESULT,0)),"^"),($L(ANS)+1),999) Q
|
|---|
| 149 | .W " ",$P($G(^DPT(+RESULT,0)),"^")
|
|---|
| 150 | S RESULT=$$MULT^IBDFDE61(CNT,.IBD) D:$D(RESULT)
|
|---|
| 151 | .W " ",$P($G(^DPT(+RESULT,0)),"^")
|
|---|
| 152 | I RESULT="" W $C(7)," ?? Not Found" S RESULT=-1
|
|---|
| 153 | ;
|
|---|
| 154 | SELQ Q
|
|---|
| 155 | ;
|
|---|
| 156 | ARRAY(ARRAY,ANS) ; -- bld array of multiple patients
|
|---|
| 157 | ; -- required variables: array = name x-ref; ans = name of selection
|
|---|
| 158 | S A=0 F S A=$O(^TMP(ARRAY,$J,IBDF("CLINIC"),ANS,A)) Q:'A S CNT=CNT+1,IBD(CNT)=A_"^"_ANS
|
|---|
| 159 | Q
|
|---|
| 160 | BLD ; -- Find all appointments for a date
|
|---|
| 161 | K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J)
|
|---|
| 162 | N SC,IBD,IBD1,NODE,SNODE
|
|---|
| 163 | S IBD=IBDFDT,SC=IBDF("CLINIC"),CNT=0
|
|---|
| 164 | F S IBD=$O(^SC(SC,"S",IBD)) Q:'IBD!(IBD>(IBDFDT+.24)) D
|
|---|
| 165 | .S IBD1=0 F S IBD1=$O(^SC(SC,"S",IBD,1,IBD1)) Q:'IBD1 D
|
|---|
| 166 | ..S NODE=$G(^SC(SC,"S",IBD,1,IBD1,0))
|
|---|
| 167 | ..S SNODE=$G(^DPT(+NODE,"S",IBD,0))
|
|---|
| 168 | ..S X=$P(SNODE,"^",2)
|
|---|
| 169 | ..I X'="","CNAPCA"[X Q ;inpatient appointments are okay
|
|---|
| 170 | ..S (DFN,IBDF("DFN"))=+NODE
|
|---|
| 171 | ..S CNT=CNT+1
|
|---|
| 172 | ..S ^TMP("IBD-PL",$J,SC,CNT)=DFN_"^"_IBD_"^"_SNODE
|
|---|
| 173 | ..S ^TMP("IBD-PLN",$J,SC,$P(^DPT(DFN,0),"^"),CNT)=DFN_"^"_IBD_"^"_SNODE
|
|---|
| 174 | ..S ^TMP("IBD-PLB",$J,SC,$E($P(^DPT(DFN,0),"^",1),1)_$E($P(^DPT(DFN,0),"^",9),6,9),CNT)=DFN_"^"_IBD_"^"_SNODE
|
|---|
| 175 | ..S ^TMP("IBD-PL4",$J,SC,$E($P(^DPT(DFN,0),"^",9),6,9),CNT)=DFN_"^"_IBD_"^"_SNODE
|
|---|
| 176 | Q
|
|---|
| 177 | ;
|
|---|
| 178 | LIST ; -- print list of patients
|
|---|
| 179 | N IBD,IBJ,FORM,STATUS,CNT,X,IBQUIT
|
|---|
| 180 | S IBQUIT=0
|
|---|
| 181 | S IBD=0 F S IBD=$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)) Q:'IBD!(IBQUIT) S NODE=$G(^TMP("IBD-PL",$J,IBDF("CLINIC"),IBD)) D ONE(NODE,IBD) I '(IBD#15) D ASKPT^IBDFDE61(IBD)
|
|---|
| 182 | Q
|
|---|
| 183 | ;
|
|---|
| 184 | ONE(NODE,IBD1) ; -- write one line
|
|---|
| 185 | N CNT,C
|
|---|
| 186 | Q:$G(NODE)=""
|
|---|
| 187 | S DFN=+NODE,APPT=$P(NODE,"^",2)
|
|---|
| 188 | S FORM=$$FINDID^IBDF18C(DFN,APPT,"",1),STATUS="NO FORM PRINTED"
|
|---|
| 189 | S CNT=0 F IBJ=1:1 S X=$P(FORM,"^",IBJ) Q:X="" S CNT=CNT+1
|
|---|
| 190 | I +FORM S Y=$P($G(^IBD(357.96,+FORM,0)),"^",11),C=$P(^DD(357.96,.11,0),"^",2) D Y^DIQ S STATUS=Y
|
|---|
| 191 | W !?2,IBD1,?5,$E($P(^DPT(DFN,0),"^"),1,18),?26,$P($G(^DPT(DFN,.36)),"^",4),?32,$$FMTE^XLFDT(+APPT),?52,$E($G(STATUS),1,24),?77,"("_CNT_")"
|
|---|
| 192 | Q
|
|---|
| 193 | ;
|
|---|
| 194 | APDT ; -- list last 30 days appointment dates in clinic
|
|---|
| 195 | S (X,Y)=$$FMADD^XLFDT(DT,-62),CNT=0
|
|---|
| 196 | F S X=$O(^SC(IBDF("CLINIC"),"S",X)) Q:'X!(X>DT) D
|
|---|
| 197 | .I $E(X,1,7)=Y Q
|
|---|
| 198 | .S Y=$E(X,1,7),CNT=CNT+1
|
|---|
| 199 | .I CNT=1 W !!,"The following are valid Appointment dates in the past 60 days:"
|
|---|
| 200 | .W:(CNT#4=1) !,?3,$$FMTE^XLFDT(Y)
|
|---|
| 201 | .W:(CNT#4=2) ?20,$$FMTE^XLFDT(Y)
|
|---|
| 202 | .W:(CNT#4=3) ?40,$$FMTE^XLFDT(Y)
|
|---|
| 203 | .W:(CNT#4=0) ?60,$$FMTE^XLFDT(Y)
|
|---|
| 204 | Q
|
|---|
| 205 | ;
|
|---|
| 206 | HDR ; -- print Clinic header
|
|---|
| 207 | N CNT,IBD,IBD1 W @IOF
|
|---|
| 208 | S CNT=0
|
|---|
| 209 | F IBD=2,6,8,9,3,4 S IBD1=$P(CLSETUP,"^",IBD) I IBD1 S CNT=CNT+1
|
|---|
| 210 | W !," Clinic: ",$E(CLNAME,1,25) W ?40," Date: ",$$FMTE^XLFDT(IBDFDT)
|
|---|
| 211 | S FORM=$P(CLSETUP,"^",2),IBDFMNME=$P($G(^IBE(357,+FORM,0)),"^")
|
|---|
| 212 | W !," Basic Form: ",$E(IBDFMNME,1,25) W ?40," Active Forms: ",CNT
|
|---|
| 213 | W !,"Appointments: ",$O(^TMP("IBD-PL",$J,IBDF("CLINIC"),""),-1)
|
|---|
| 214 | W !,$TR($J(" ",IOM)," ","=")
|
|---|
| 215 | Q
|
|---|
| 216 | ;
|
|---|
| 217 | END K I,J,X,Y,DA,DR,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,IBDSEL,CHOICE,TEXT,TEXTU,RESULT,IBDPI,IBDCO,IBDF
|
|---|
| 218 | K ^TMP("IBD-PL",$J),^TMP("IBD-PLN",$J),^TMP("IBD-PLB",$J),^TMP("IBD-PL4",$J),^TMP("IBD-MORE",$J),^TMP("IBD-PLCHK",$J)
|
|---|
| 219 | K ^TMP("IBD-ASK",$J),^TMP("IBD-LCODE",$J),^TMP("IBD-LST",$J),^TMP("IBD-LTEXT",$J),^TMP("IBD-OBJ",$J)
|
|---|
| 220 | Q
|
|---|
