| [613] | 1 | DGENRPT1 ;ALB/DW,LBD - EGT Preliminary Summary Impact Report ; 04/24/03 2:32pm ; 07/22/02 9:40am
|
|---|
| 2 | ;;5.3;Registration;**232,306,417,456,491,513**;Aug 13,1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ENPT ;Preliminary Summary Report selected.
|
|---|
| 6 | K ^TMP($J,"SS1"),^TMP($J,"RT1")
|
|---|
| 7 | I $$FINDCUR^DGENEGT()=0 W !,"No EGT setting on file." Q
|
|---|
| 8 | D PRINT
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | GETEGTS ;First get the current EGT parameters from file #27.16.
|
|---|
| 12 | N GETEGTS,REC,TP S (GETEGTS,REC,TP)=""
|
|---|
| 13 | S REC=$$FINDCUR^DGENEGT() I REC=0 Q
|
|---|
| 14 | S TP=$$GET^DGENEGT(REC,.GETEGTS)
|
|---|
| 15 | ;Get EGT Prioity.
|
|---|
| 16 | S EGT=GETEGTS("PRIORITY")
|
|---|
| 17 | S EGTSUB=GETEGTS("SUBGRP")
|
|---|
| 18 | ;Get EGT Effective Date.
|
|---|
| 19 | S EGTEDT=GETEGTS("EFFDATE") I EGTEDT S EGTEDT=$$FMTE^XLFDT(EGTEDT)
|
|---|
| 20 | ;Get last EGT setting Date/Time.
|
|---|
| 21 | S EGTLDT=GETEGTS("ENTDATE") I EGTLDT S EGTLDT=$$FMTE^XLFDT(EGTLDT)
|
|---|
| 22 | ;Get EGT Type.
|
|---|
| 23 | S EGTTP=GETEGTS("TYPE")
|
|---|
| 24 | S EGTTP=$$EXTERNAL^DILFD(27.16,.04,"F",EGTTP) S:EGTTP="" EGTTP="UNSPECIFIED"
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | PRESRT1 ;Sort for patient's current record and get the potentially affected.
|
|---|
| 28 | N IND,PRT,DFN,INPT,PSSN,TMP,ABV,PRTSUB
|
|---|
| 29 | S (IND,PRT,DFN,PSSN,TMP,ABV,PRTSUB)="",INPT="OUT"
|
|---|
| 30 | K ^TMP($J,"SS1"),^TMP($J,"RT1")
|
|---|
| 31 | F S DFN=$O(^DGEN(27.11,"C",DFN)) Q:DFN="" D
|
|---|
| 32 | . S IND=$$FINDCUR^DGENA(DFN)
|
|---|
| 33 | . I IND D EGTP I ABV=0 D
|
|---|
| 34 | .. K VAIP(2) S INPT="OUT" D IN5^VADPT S TMP=$P($G(VAIP(2)),U) I TMP=1!(TMP=2)!(TMP=6) S INPT="IN"
|
|---|
| 35 | .. K VADM(2) D DEM^VADPT S PSSN=$P($G(VADM(2)),U)
|
|---|
| 36 | .. S ^TMP($J,"RT1",PRT,PSSN)=PRT_"^"_INPT
|
|---|
| 37 | ;
|
|---|
| 38 | PRESRT2 ;Sort the sorted.
|
|---|
| 39 | N CNT,ICNT,OCNT,J,K
|
|---|
| 40 | S (J,K)=""
|
|---|
| 41 | F S J=$O(^TMP($J,"RT1",J)) Q:J="" D
|
|---|
| 42 | . S (CNT,ICNT,OCNT)=0
|
|---|
| 43 | . F S K=$O(^TMP($J,"RT1",J,K)) Q:K="" D
|
|---|
| 44 | .. S INPT=$P($G(^TMP($J,"RT1",J,K)),U,2)
|
|---|
| 45 | .. S CNT=CNT+1 S:INPT="IN" ICNT=ICNT+1 S:INPT="OUT" OCNT=OCNT+1
|
|---|
| 46 | .. S ^TMP($J,"SS1",J)=CNT_"^"_ICNT_"^"_OCNT
|
|---|
| 47 | K ^TMP($J,"RT1")
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | EGTP ;Decide if the patient is above EGT.
|
|---|
| 51 | S (PRT,PRTSUB,ABV,ENRDT)=""
|
|---|
| 52 | S PRT=$P($G(^DGEN(27.11,IND,0)),U,7)
|
|---|
| 53 | S:((PRT=7)!(PRT=8)) PRTSUB=$P($G(^DGEN(27.11,IND,0)),U,12)
|
|---|
| 54 | S ENRDT=$P($G(^DGEN(27.11,IND,0)),U,10)
|
|---|
| 55 | S:'ENRDT ENRDT=$P($G(^DGEN(27.11,IND,0)),U)
|
|---|
| 56 | S ABV=$$ABOVE^DGENEGT1(DFN,PRT,PRTSUB)
|
|---|
| 57 | I PRT=7!(PRT=8) D
|
|---|
| 58 | . S PRTSUB=$$EXTERNAL^DILFD(27.11,.12,"F",PRTSUB)
|
|---|
| 59 | . S:PRTSUB="" PRTSUB="ER"
|
|---|
| 60 | S PRT=PRT_PRTSUB
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | PRINT ;Print the report.
|
|---|
| 64 | N POP,IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY,ZTSAVE,TSK,%ZIS,ZTRTN,ZTDESC
|
|---|
| 65 | S %ZIS="QM" D ^%ZIS G EXIT:POP
|
|---|
| 66 | I $D(IO("Q")) D G EXIT
|
|---|
| 67 | . S ZTRTN="WRITER^DGENRPT1",ZTDESC="DG EGT Preliminary Summary Report."
|
|---|
| 68 | . D ^%ZTLOAD
|
|---|
| 69 | . S TSK=$S($D(ZTSK)=0:"C",1:"Y")
|
|---|
| 70 | . I TSK="Y" W !!,"Report queued! Task number: ",ZTSK
|
|---|
| 71 | . D HOME^%ZIS
|
|---|
| 72 | ;
|
|---|
| 73 | WRITER ;Write out the report.
|
|---|
| 74 | U IO
|
|---|
| 75 | I $E(IOST,1,2)="C-" W @IOF
|
|---|
| 76 | N EGT,EGTSUB,EGTEDT,EGTLDT,EGTTP,ENRDT
|
|---|
| 77 | S (EGT,EGTSUB,EGTEDT,EGTLDT,EGTTP)=""
|
|---|
| 78 | D GETEGTS
|
|---|
| 79 | D PRESRT1
|
|---|
| 80 | D PSHEAD
|
|---|
| 81 | D DATA
|
|---|
| 82 | D ^%ZISC
|
|---|
| 83 | EXIT S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 84 | D KVA^VADPT
|
|---|
| 85 | K ^TMP($J,"SS1")
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | PSHEAD ;Header for the Preliminary Detailed Report.
|
|---|
| 89 | ;Get the date/time the report is run.
|
|---|
| 90 | N RDT,Y S (RDT,Y)=""
|
|---|
| 91 | D NOW^%DTC S Y=% X ^DD("DD")
|
|---|
| 92 | S RDT=$P(Y,"@",1)_" @ "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 93 | S EGTSUB=$$EXTERNAL^DILFD(27.16,.03,"F",EGTSUB)
|
|---|
| 94 | I ((EGT=7)!(EGT=8)),EGTSUB="" S EGTSUB="ER"
|
|---|
| 95 | ;Write the header.
|
|---|
| 96 | W !,?((IOM-38)\2),"EGT Preliminary Summary Impact Report"
|
|---|
| 97 | W !,?((IOM-22-$L(RDT))\2),"Date/Time Report Run: ",RDT
|
|---|
| 98 | W !,?((IOM-45-$L(EGT_EGTSUB_EGTTP_EGTEDT))\2),"EGT Setting: ",EGT_EGTSUB," EGT Type: ",EGTTP," EGT Effective Date: ",EGTEDT
|
|---|
| 99 | W !,?((IOM-28-$L(EGTLDT))\2),"Date/Time Last EGT Setting: ",EGTLDT
|
|---|
| 100 | W !!,"IMPORTANT NOTE:",!,"Preliminary report is based on a comparison of the EGT setting to the veterans current enrollment priority as shown in VISTA."
|
|---|
| 101 | W !!,"ENROLLMENT PRIORITY",?23,"TOTAL (UNIQUE SSN)",?43,"# INPATIENT",?57,"# OUTPATIENT",!
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | DATA ;Get all the data for the report.
|
|---|
| 105 | N T,EP,TLT,INPT,OPT,COUNT S (T,EP,TLT,INPT,OPT)="",COUNT=0
|
|---|
| 106 | F S T=$O(^TMP($J,"SS1",T)) Q:T="" D
|
|---|
| 107 | . S EP=T,TLT=$P($G(^TMP($J,"SS1",T)),U),INPT=$P($G(^TMP($J,"SS1",T)),U,2),OPT=$P($G(^TMP($J,"SS1",T)),U,3)
|
|---|
| 108 | . S COUNT=COUNT+TLT
|
|---|
| 109 | . W !,EP,?25,TLT,?45,INPT,?59,OPT
|
|---|
| 110 | W !,"TOTAL PATIENTS (UNIQUE SSNS) FOR THIS FACILITY: ",COUNT
|
|---|
| 111 | Q
|
|---|
