| 1 | DGENRPT4 ;ALB/DW,LBD/EG - EGT Actual Detailed Impact Report ; 1/20/05 1:04pm
|
---|
| 2 | ;;5.3;Registration;**232,306,417,456,491,513,568,585**;Aug 13,1993
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | ENPT ;Actual Detailed Report selected.
|
---|
| 6 | K ^TMP($J,"BY4"),^TMP($J,"CNT4")
|
---|
| 7 | N INFAP,BDT,EDT S (INFAP,BDT,EDT)=""
|
---|
| 8 | D RPDT I BDT="^"!(EDT="^")!($D(DTOUT)) Q
|
---|
| 9 | D INFAP I INFAP="^"!($D(DTOUT)) Q
|
---|
| 10 | N EGT,EGTSUB,EGTEDT,EGTLDT,EGTTP,L,BY,DIC,FLDS,DHD,DIOEND,X,DFN,PSSN,FCTY,DIOBEG,VASD,VAERR,RLEGT,ENRDT
|
---|
| 11 | S (EGT,EGTSUB,EGTEDT,EGTLDT,EGTTP,FCTY,RLEGT)=""
|
---|
| 12 | W !!,"*** This report requires a 132 column printer. ***",!!
|
---|
| 13 | S DIC="^DGEN(27.11,"
|
---|
| 14 | S DIOBEG="D PRESORT^DGENRPT4"
|
---|
| 15 | S BY(0)="^TMP($J,""BY4"",",L(0)=3,L=0
|
---|
| 16 | S FLDS="D PT^DGENRPT4 W X;C0;L20,W PSSN;C22;L10,D EP^DGENRPT4 W X;C33;L2,D ENRED^DGENRPT4 W X;C37;L10,D ENRST^DGENRPT4 W X;C49;L12"
|
---|
| 17 | I INFAP=1 D
|
---|
| 18 | . S FLDS(2)="D WRD^DGENRPT4 W X;C63;L15;""WARD"",D FAP1^DGENRPT4 W X;C80;L31,D PCPVD^DGENRPT4 W X;C110;L10,D PFCLTY^DGENRPT4 W X;C121;L11"
|
---|
| 19 | . S DHD="W ?0 D DETHD1^DGENRPT4"
|
---|
| 20 | I INFAP=0 D
|
---|
| 21 | . S FLDS(2)="D WRD^DGENRPT4 W X;C63;L15;""WARD"",D FAP0^DGENRPT4 W X;C80;L31,D PCPVD^DGENRPT4 W X;C88;L10,D PFCLTY^DGENRPT4 W X;C100;L12"
|
---|
| 22 | . S DHD="W ?0 D DETHD0^DGENRPT4"
|
---|
| 23 | S DIOEND="D END^DGENRPT4"
|
---|
| 24 | D EN1^DIP
|
---|
| 25 | D EXIT
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | INFAP ;Ask the user if Future Appointments is wanted on the report.
|
---|
| 29 | N DIR,X,Y
|
---|
| 30 | S DIR(0)="Y^1:3"
|
---|
| 31 | S DIR("A")="Do you want to include Future Appointments"
|
---|
| 32 | D ^DIR S INFAP=Y
|
---|
| 33 | I ($D(DTOUT)) W *7
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|
| 36 | RPDT ;Ask the user the Report Begin Date and Report End Date.
|
---|
| 37 | N DIR,X,Y
|
---|
| 38 | S DIR(0)="DA^::E"
|
---|
| 39 | S DIR("A")="Report Begin Date: "
|
---|
| 40 | S DIR("?")="Please enter the Enrollment End Date as the beginning date that will be reported on."
|
---|
| 41 | D ^DIR S BDT=Y
|
---|
| 42 | I BDT="^" Q
|
---|
| 43 | I ($D(DTOUT)) W *7 Q
|
---|
| 44 | ;
|
---|
| 45 | RPDT2 S DIR(0)="DA^::E"
|
---|
| 46 | S DIR("A")="Report End Date: "
|
---|
| 47 | S DIR("?")="Please enter the Enrollment End Date as the end date that will be reported on. Report End Date cannot be earlier than Report Begin Date."
|
---|
| 48 | D ^DIR S EDT=Y
|
---|
| 49 | I EDT="^" Q
|
---|
| 50 | I ($D(DTOUT)) W *7 Q
|
---|
| 51 | I EDT<BDT G RPDT2
|
---|
| 52 | Q
|
---|
| 53 | ;
|
---|
| 54 | PRESORT ;First get the current EGT Setting from file #27.16.
|
---|
| 55 | N GETEGTS,REC,TP S (GETEGTS,REC,TP)=""
|
---|
| 56 | S REC=$$FINDCUR^DGENEGT()
|
---|
| 57 | ;If no EGT setting on file, print patient of all enrollment priorities.
|
---|
| 58 | I REC=0 W !,"No EGT setting on file.",! S EGT=0 G PRESRT1
|
---|
| 59 | S TP=$$GET^DGENEGT(REC,.GETEGTS)
|
---|
| 60 | ;Get EGT Priority.
|
---|
| 61 | S EGT=GETEGTS("PRIORITY"),RLEGT=EGT
|
---|
| 62 | I EGT="" W !,"No EGT setting on file.",! S EGT=0
|
---|
| 63 | S EGTSUB=GETEGTS("SUBGRP")
|
---|
| 64 | ;Get EGT Effective Date.
|
---|
| 65 | S EGTEDT=GETEGTS("EFFDATE") I EGTEDT S EGTEDT=$$FMTE^XLFDT(EGTEDT)
|
---|
| 66 | ;Get last EGT setting Date/Time.
|
---|
| 67 | S EGTLDT=GETEGTS("ENTDATE") I EGTLDT S EGTLDT=$$FMTE^XLFDT(EGTLDT)
|
---|
| 68 | ;Get EGT Type.
|
---|
| 69 | S EGTTP=GETEGTS("TYPE")
|
---|
| 70 | S EGTTP=$$EXTERNAL^DILFD(27.16,.04,"F",EGTTP) S:EGTTP="" EGTTP="UNSPECIFIED"
|
---|
| 71 | ;
|
---|
| 72 | PRESRT1 ;Sort for patient's current record and get the potentially affected.
|
---|
| 73 | N IND,PRT,DFN,NM,PSSN,PEDT,PCTRY,PRTSUB,ABV
|
---|
| 74 | S (IND,PRT,DFN,NM,PSSN,PEDT,PCTRY,PRTSUB,ABV)=""
|
---|
| 75 | K ^TMP($J,"BY4"),^TMP($J,"CNT4")
|
---|
| 76 | F S DFN=$O(^DGEN(27.11,"C",DFN)) Q:DFN="" D
|
---|
| 77 | . S IND=$$FINDCUR^DGENA(DFN)
|
---|
| 78 | . I IND D
|
---|
| 79 | .. D EGTP
|
---|
| 80 | .. S PEDT=$P($G(^DGEN(27.11,IND,0)),U,11)
|
---|
| 81 | .. S PCTRY=$$CATEGORY^DGENA4(DFN)
|
---|
| 82 | .. I ABV=0&(PCTRY="N")&(PEDT'<BDT)&(PEDT'>EDT) D
|
---|
| 83 | ... K VADM(1),VADM(2) D DEM^VADPT S NM=VADM(1) D BYSRT
|
---|
| 84 | ... S PSSN=$P($G(VADM(2)),U),^TMP($J,"CNT4",PRT,PSSN)=""
|
---|
| 85 | I EGTSUB>4 S EGTSUB="ER" Q
|
---|
| 86 | S EGTSUB=$$EXTERNAL^DILFD(27.16,.03,"F",EGTSUB)
|
---|
| 87 | D GETAPPT^DGENRPT5("BY4")
|
---|
| 88 | Q
|
---|
| 89 | ;
|
---|
| 90 | EGTP ;Get patients EGT Priority.
|
---|
| 91 | S (PRT,PRTSUB,ABV,ENRDT)=""
|
---|
| 92 | S PRT=$P($G(^DGEN(27.11,IND,0)),U,7)
|
---|
| 93 | S:((PRT=7)!(PRT=8)) PRTSUB=$P($G(^DGEN(27.11,IND,0)),U,12)
|
---|
| 94 | S ENRDT=$P($G(^DGEN(27.11,IND,0)),U,10)
|
---|
| 95 | S:'ENRDT ENRDT=$P($G(^DGEN(27.11,IND,0)),U)
|
---|
| 96 | S ABV=$$ABOVE^DGENEGT1(DFN,PRT,PRTSUB)
|
---|
| 97 | I PRT=7!(PRT=8) D
|
---|
| 98 | . S PRTSUB=$$EXTERNAL^DILFD(27.11,.12,"F",PRTSUB)
|
---|
| 99 | . S:PRTSUB="" PRTSUB="ER"
|
---|
| 100 | S PRT=PRT_PRTSUB
|
---|
| 101 | Q
|
---|
| 102 | ;
|
---|
| 103 | BYSRT ;Sort patients by last name for "BY(0)".
|
---|
| 104 | S ^TMP($J,"BY4",NM,DFN,IND)=""
|
---|
| 105 | Q
|
---|
| 106 | ;
|
---|
| 107 | PT ;Get the patient NAME and SSN
|
---|
| 108 | S (X,DFN,PSSN)="" K VADM(1),VADM(2)
|
---|
| 109 | S DFN=$P($G(^DGEN(27.11,D0,0)),U,2)
|
---|
| 110 | I DFN D DEM^VADPT S X=$E(VADM(1),1,20),PSSN=$P(VADM(2),U)
|
---|
| 111 | Q
|
---|
| 112 | ;
|
---|
| 113 | EP ;Get the patient EGT Priority.
|
---|
| 114 | S X=""
|
---|
| 115 | N PRT,PRTSUB S (PRT,PRTSUB)=""
|
---|
| 116 | S PRT=$P($G(^DGEN(27.11,D0,0)),U,7)
|
---|
| 117 | I PRT=7!(PRT=8) D
|
---|
| 118 | .S PRTSUB=$P($G(^DGEN(27.11,D0,0)),U,12)
|
---|
| 119 | .S PRTSUB=$$EXTERNAL^DILFD(27.11,.12,"F",PRTSUB)
|
---|
| 120 | .S:PRTSUB="" PRTSUB="ER"
|
---|
| 121 | .S PRT=PRT_PRTSUB
|
---|
| 122 | S X=PRT
|
---|
| 123 | Q
|
---|
| 124 | ;
|
---|
| 125 | ENRED ;Get the patient ENROLLMENT END DATE.
|
---|
| 126 | S X=""
|
---|
| 127 | S X=$P($G(^DGEN(27.11,D0,0)),U,11)
|
---|
| 128 | I X="" S X="N/A" Q
|
---|
| 129 | S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_(1700+$E(X,1,3))
|
---|
| 130 | Q
|
---|
| 131 | ;
|
---|
| 132 | ENRST ;Get the patient ENROLLMENT STATUS.
|
---|
| 133 | S X=""
|
---|
| 134 | S X=$P($G(^DGEN(27.11,D0,0)),U,4)
|
---|
| 135 | S X=$P($G(^DGEN(27.15,X,0)),U,1),X=$E(X,1,12)
|
---|
| 136 | Q
|
---|
| 137 | ;
|
---|
| 138 | WRD ;Get the patient WARD.
|
---|
| 139 | S X="" K VAIP(5)
|
---|
| 140 | D IN5^VADPT S X=$P($G(VAIP(5)),U,2),X=$E(X,1,15)
|
---|
| 141 | I X="" S X="N/A"
|
---|
| 142 | Q
|
---|
| 143 | ;
|
---|
| 144 | FAP1 ;Get the patient FUTURE APPOINTMENTS.
|
---|
| 145 | N J,POP,ADT S (X,J,ADT)="",POP=0
|
---|
| 146 | K ^UTILITY("VASD",$J)
|
---|
| 147 | ;if there is lower level data, then it is an error eg 01/20/2005
|
---|
| 148 | I $D(^TMP($J,"SDAMA",101))=1 S X="Appt. DB Unavail." Q
|
---|
| 149 | D BLDUTL^DGENRPT5(DFN)
|
---|
| 150 | F S J=$O(^UTILITY("VASD",$J,J)) Q:J=""!POP D
|
---|
| 151 | . S X=$P($G(^UTILITY("VASD",$J,J,"E")),U,2),X=$E(X,1,20)
|
---|
| 152 | . S ADT=$P($G(^UTILITY("VASD",$J,J,"I")),U),ADT=$P(ADT,".",1)
|
---|
| 153 | . S ADT=$E(ADT,4,5)_"/"_$E(ADT,6,7)_"/"_(1700+$E(ADT,1,3))
|
---|
| 154 | . S X=ADT_" "_X
|
---|
| 155 | . I J=1 W X S X=""
|
---|
| 156 | . I J>1&(J<6) W !,?79,X S X=""
|
---|
| 157 | . I J=6 S X="" W !,?79,"More Appts" S POP=1 Q
|
---|
| 158 | I $D(^UTILITY("VASD",$J))=0 S X="NONE"
|
---|
| 159 | Q
|
---|
| 160 | ;
|
---|
| 161 | FAP0 ;See if the patient has future appointment.
|
---|
| 162 | S X="NO"
|
---|
| 163 | K ^UTILITY("VASD",$J)
|
---|
| 164 | ;in order to be a valid appointment, there must be
|
---|
| 165 | ;lower level subscripts. if not, then it is
|
---|
| 166 | ;an error eg 01/20/2005
|
---|
| 167 | I $D(^TMP($J,"SDAMA",101))=1 S X="Appt. DB Unavail." Q
|
---|
| 168 | D BLDUTL^DGENRPT5(DFN)
|
---|
| 169 | I $G(^UTILITY("VASD",$J,1,"I"))'="" S X="YES"
|
---|
| 170 | Q
|
---|
| 171 | ;
|
---|
| 172 | PCPVD ;Get the patient PC PROVIDER.
|
---|
| 173 | ;;Site must use PCMM module.
|
---|
| 174 | S X=""
|
---|
| 175 | S X=$$PCPRACT^DGSDUTL(DFN)
|
---|
| 176 | I X="" S X="N/A" Q
|
---|
| 177 | S X=$P(X,U,2),X=$E(X,1,10)
|
---|
| 178 | Q
|
---|
| 179 | ;
|
---|
| 180 | PFCLTY ;Get the patient PREFFERED FACILITY.
|
---|
| 181 | S (X,FCTY)=""
|
---|
| 182 | S X=$$PREF^DGENPTA(DFN,.FCTY),X=$E(FCTY,1,11)
|
---|
| 183 | I X="" S X="N/A"
|
---|
| 184 | Q
|
---|
| 185 | ;
|
---|
| 186 | DETHD ;General header for the Preliminary Detailed Report.
|
---|
| 187 | ;Get the date/time the report is run.
|
---|
| 188 | N RDT,Y,DT1,DT2 S (RDT,Y,DT1,DT2)=""
|
---|
| 189 | D NOW^%DTC S Y=% X ^DD("DD")
|
---|
| 190 | S RDT=$P(Y,"@",1)_" @ "_$P($P(Y,"@",2),":",1,2)
|
---|
| 191 | S DT1=$$FMTE^XLFDT(BDT),DT2=$$FMTE^XLFDT(EDT)
|
---|
| 192 | ;Write the header.
|
---|
| 193 | W !,?((IOM-33)\2),"EGT Actual Detailed Impact Report"
|
---|
| 194 | W !,?((IOM-38-$L(DT1_DT2))\2),"Date Range of Enrollment End Date: ",DT1," - ",DT2
|
---|
| 195 | W !,?((IOM-22-$L(RDT))\2),"Date/Time Report Run: ",RDT
|
---|
| 196 | W !,?((IOM-45-$L(RLEGT_EGTSUB_EGTTP_EGTEDT))\2),"EGT Setting: ",RLEGT_EGTSUB," EGT Type: ",EGTTP," EGT Effective Date: ",EGTEDT
|
---|
| 197 | W !,?((IOM-28-$L(EGTLDT))\2),"Date/Time Last EGT Setting: ",EGTLDT
|
---|
| 198 | W !!,"IMPORTANT NOTE: Actual report is based on a comparison of the EGT Setting and the Enrollment Category as provided by HEC."
|
---|
| 199 | Q
|
---|
| 200 | ;
|
---|
| 201 | DETHD1 ;Header for the Preliminary Detailed Report, with Future Appointments.
|
---|
| 202 | D DETHD
|
---|
| 203 | W !!,"NAME",?21,"SSN",?32,"EP",?36,"ENROLLMENT",?48,"ENROLLMENT",?62,"WARD",?79,"FUTURE",?109,"PC",?120,"PREF"
|
---|
| 204 | W !,?36,"END DATE",?48,"STATUS",?79,"APPOINTMENTS",?109,"PROVIDER",?120,"FACILITY",!!
|
---|
| 205 | Q
|
---|
| 206 | ;
|
---|
| 207 | DETHD0 ;Header for the Preliminary Detailed Report, no Future Appointments.
|
---|
| 208 | D DETHD
|
---|
| 209 | W !!,"NAME",?21,"SSN",?32,"EP",?36,"ENROLLMENT",?48,"ENROLLMENT",?62,"WARD",?79,"FUTURE",?87,"PC",?99,"PREF"
|
---|
| 210 | W !,?36,"END DATE",?48,"STATUS",?79,"APPTS",?87,"PROVIDER",?99,"FACILITY",!!
|
---|
| 211 | Q
|
---|
| 212 | ;
|
---|
| 213 | END ;At the end of the display.
|
---|
| 214 | N PSSN,J,COUNT S (PSSN,J)="",COUNT=0
|
---|
| 215 | F S J=$O(^TMP($J,"CNT4",J)) Q:J="" D
|
---|
| 216 | . F S PSSN=$O(^TMP($J,"CNT4",J,PSSN)) Q:PSSN="" S COUNT=COUNT+1
|
---|
| 217 | W !,"TOTAL PATIENTS (UNIQUE SSNS) FOR THIS FACILITY: ",COUNT
|
---|
| 218 | Q
|
---|
| 219 | ;
|
---|
| 220 | EXIT ;Clean up upon exit of the routine.
|
---|
| 221 | D KVA^VADPT
|
---|
| 222 | K ^TMP($J,"BY4"),^TMP($J,"CNT4")
|
---|
| 223 | Q
|
---|