source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRPT1.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1DGENRPT1 ;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 ;
5ENPT ;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 ;
11GETEGTS ;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 ;
27PRESRT1 ;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 ;
38PRESRT2 ;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 ;
50EGTP ;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 ;
63PRINT ;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 ;
73WRITER ;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
83EXIT S:$D(ZTQUEUED) ZTREQ="@"
84 D KVA^VADPT
85 K ^TMP($J,"SS1")
86 Q
87 ;
88PSHEAD ;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 ;
104DATA ;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
Note: See TracBrowser for help on using the repository browser.