DGENRPA2 ;ALB/CJM/CKN - Enrolled Veterans Report Cont.; JUL 9,1997 ; 11/15/01 8:47am ; 07/22/02
;;5.3;Registration;**121,147,232,306,417,456**;Aug 13,1993
;
PRINT ;
N STATS,CRT,QUIT,PAGE1
S QUIT=0
S PAGE1=1
S CRT=$S($E(IOST,1,2)="C-":1,1:0)
;
D GETSTATS
U IO
I CRT,PAGE1 W @IOF S PAGE1=0
D HEADER
D PART1
;D:'QUIT PART2
;I 'QUIT,CRT D PAUSE
I $D(ZTQUEUED) S ZTREQ="@"
D ^%ZISC
Q
LINE(LINE) ;
;Description: prints a line. First prints header if at end of page.
;
I CRT,($Y>(IOSL-4)) D
.D PAUSE
.Q:QUIT
.W @IOF
.D HEADER
.W LINE
;
E I ('CRT),($Y>(IOSL-2)) D
.W @IOF
.D HEADER
.W LINE
;
E W !,LINE
Q
;
GETSTATS ;
;Description: Gathers the statistics for the report
;
;*** note *** - part II of report removed, lines commented out were
;for that reason
;
N DFN,PRIORITY,STATUS,I,ENRSBGRP
S STATUS=""
F S STATUS=$O(^DPT("AENRC",STATUS)) Q:STATUS="" D
.S DFN=0
.F S DFN=$O(^DPT("AENRC",STATUS,DFN)) Q:'DFN D
..S ENRSBGRP=""
..S PRIORITY=+$$PRIORITY^DGENA(DFN)
..S:((PRIORITY=7)!(PRIORITY=8)) ENRSBGRP=$$EXT^DGENU("SUBGRP",$$ENRSBGRP^DGENA4(DFN))
..S CATEGORY=$$CATEGORY^DGENA4(DFN)
..S STATS("PRI",PRIORITY_ENRSBGRP)=1+$G(STATS("PRI",PRIORITY_ENRSBGRP))
..S STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY)=1+$G(STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY))
..S STATS("STATUS",STATUS)=1+$G(STATS("STATUS",STATUS))
;.E I $$VET^DGENPTA(DFN),'$$DEATH^DGENPTA(DFN),$$ACTIVE^DGENPTA(DFN,$G(INDATE)) D
;..S STATUS=+$$STATUS^DGENA(DFN)
;..S STATS("NOT ENROLLED","STATUS",STATUS)=1+$G(STATS("NOT ENROLLED","STATUS",STATUS))
Q
;
;Description: Prints the report header.
;
W !,?((IOM-24)\2),"Enrolled Veterans Report"
W !,?((IOM-12)\2),$$FMTE^XLFDT(DT,"D")
W !!
Q
;
PAUSE ;
;Description: Screen pause. Sets QUIT=1 if user decides to quit.
;
N DIR,X,Y
F Q:$Y>(IOSL-3) W !
S DIR(0)="E" D ^DIR
I '(+Y) S QUIT=1
Q
;
PART1 ;
;Description: Prints statistics for enrolled veterans.
;
N AMOUNT,TOTAL,STATUS,PRIORITY,CATEGORY,TOTCAT
W !!,"CURRENTLY ENROLLED VETERANS AND VETERANS WITH PENDING APPLICATIONS",!!
W ?59,"Enrolled",?75,"Not Enrolled",?97,"In Process",!
S TOTAL=0
S PRIORITY=""
F S PRIORITY=$O(STATS("PRI",PRIORITY)) Q:PRIORITY="" D Q:QUIT
.S AMOUNT=+$G(STATS("PRI",PRIORITY))
.D:PRIORITY=0 LINE(" NO Priority Group: "_" "_$$F(AMOUNT))
.D:PRIORITY'=0 LINE(" Priority Group "_$S($L(PRIORITY)=1:PRIORITY_" : ",1:$E(PRIORITY)_$E(PRIORITY,2)_" : ")_$$F(AMOUNT))
.D CATEGORY(1)
.S TOTAL=TOTAL+AMOUNT
Q:QUIT
D LINE(" =====================================")
Q:QUIT
D LINE(" Total: "_$$F(TOTAL))
D CATEGORY(0)
Q:QUIT
W !!
S (TOTAL,STATUS)=0
F S STATUS=$O(STATS("STATUS",STATUS)) Q:STATUS="" D Q:QUIT
.S AMOUNT=+STATS("STATUS",STATUS)
.D LINE($$LJ^XLFSTR(" "_$E($$STATUS(STATUS),1,45)_" Status:",54)_$$F(AMOUNT))
.S TOTAL=TOTAL+(AMOUNT)
Q:QUIT
D LINE(" ==============================================================")
Q:QUIT
D LINE($$LJ^XLFSTR(" Total:",54)_$$F(TOTAL))
Q
;
PART2 ;
;Description: Prints statistics for veterans not enrolled.
;
N AMOUNT,STATUS,PRIORITY,TOTAL
D LINE(" ")
D LINE(" ")
D LINE("VETERANS NOT ENROLLED WITH INPATIENT OR OUTPATIENT ACTIVITY SINCE "_$$FMTE^XLFDT(INDATE,"D"))
D LINE(" ")
S TOTAL=0
F STATUS=3:1:9 D Q:QUIT
.S AMOUNT=$G(STATS("NOT ENROLLED","STATUS",STATUS))
.D LINE($$LJ^XLFSTR(" "_$$STATUS(STATUS)_" Status:",40)_$$F(AMOUNT))
.S TOTAL=TOTAL+(AMOUNT)
Q:QUIT
D LINE(" ================================================")
Q:QUIT
D LINE($$LJ^XLFSTR(" Total:",40)_$$F(TOTAL))
Q
;
F(X) ;
;Description: Formats X, a number, used as standard format for report.
;
Q $J($FN(X,","),12)
;
STATUS(STATUS) ;
;Description: Returns status name.
;
Q $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
;
CATEGORY(FLG) ;
;Displays category totals for each priority
; Input:
; FLG - 0 Displays category totals for each priority
; 1 Displays total categorys
;
N CATEGORY
F CATEGORY="E","N","P" D
.W ?$S(CATEGORY="E":55,CATEGORY="N":75,1:95)
.I FLG D Q
..Q:+$G(STATS("PRI",PRIORITY,"CAT",CATEGORY))=0
..W $$F(STATS("PRI",PRIORITY,"CAT",CATEGORY))
..S TOTCAT(CATEGORY)=$G(TOTCAT(CATEGORY))+STATS("PRI",PRIORITY,"CAT",CATEGORY)
.Q:+$G(TOTCAT(CATEGORY))=0
.W $$F(TOTCAT(CATEGORY))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENRPA2 4464 printed Apr 09, 2024@21:42:58 Page 2
DGENRPA2 ;ALB/CJM/CKN - Enrolled Veterans Report Cont.; JUL 9,1997 ; 11/15/01 8:47am ; 07/22/02
+1 ;;5.3;Registration;**121,147,232,306,417,456**;Aug 13,1993
+2 ;
PRINT ;
+1 NEW STATS,CRT,QUIT,PAGE1
+2 SET QUIT=0
+3 SET PAGE1=1
+4 SET CRT=$SELECT($EXTRACT(IOST,1,2)="C-":1,1:0)
+5 ;
+6 DO GETSTATS
+7 USE IO
+8 IF CRT
IF PAGE1
WRITE @IOF
SET PAGE1=0
+9 DO HEADER
+10 DO PART1
+11 ;D:'QUIT PART2
+12 ;I 'QUIT,CRT D PAUSE
+13 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+14 DO ^%ZISC
+15 QUIT
LINE(LINE) ;
+1 ;Description: prints a line. First prints header if at end of page.
+2 ;
+3 IF CRT
IF ($Y>(IOSL-4))
Begin DoDot:1
+4 DO PAUSE
+5 if QUIT
QUIT
+6 WRITE @IOF
+7 DO HEADER
+8 WRITE LINE
End DoDot:1
+9 ;
+10 IF '$TEST
IF ('CRT)
IF ($Y>(IOSL-2))
Begin DoDot:1
+11 WRITE @IOF
+12 DO HEADER
+13 WRITE LINE
End DoDot:1
+14 ;
+15 IF '$TEST
WRITE !,LINE
+16 QUIT
+17 ;
GETSTATS ;
+1 ;Description: Gathers the statistics for the report
+2 ;
+3 ;*** note *** - part II of report removed, lines commented out were
+4 ;for that reason
+5 ;
+6 NEW DFN,PRIORITY,STATUS,I,ENRSBGRP
+7 SET STATUS=""
+8 FOR
SET STATUS=$ORDER(^DPT("AENRC",STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+9 SET DFN=0
+10 FOR
SET DFN=$ORDER(^DPT("AENRC",STATUS,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 SET ENRSBGRP=""
+12 SET PRIORITY=+$$PRIORITY^DGENA(DFN)
+13 if ((PRIORITY=7)!(PRIORITY=8))
SET ENRSBGRP=$$EXT^DGENU("SUBGRP",$$ENRSBGRP^DGENA4(DFN))
+14 SET CATEGORY=$$CATEGORY^DGENA4(DFN)
+15 SET STATS("PRI",PRIORITY_ENRSBGRP)=1+$GET(STATS("PRI",PRIORITY_ENRSBGRP))
+16 SET STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY)=1+$GET(STATS("PRI",PRIORITY_ENRSBGRP,"CAT",CATEGORY))
+17 SET STATS("STATUS",STATUS)=1+$GET(STATS("STATUS",STATUS))
End DoDot:2
End DoDot:1
+18 ;.E I $$VET^DGENPTA(DFN),'$$DEATH^DGENPTA(DFN),$$ACTIVE^DGENPTA(DFN,$G(INDATE)) D
+19 ;..S STATUS=+$$STATUS^DGENA(DFN)
+20 ;..S STATS("NOT ENROLLED","STATUS",STATUS)=1+$G(STATS("NOT ENROLLED","STATUS",STATUS))
+21 QUIT
+22 ;
+1 ;Description: Prints the report header.
+2 ;
+3 WRITE !,?((IOM-24)\2),"Enrolled Veterans Report"
+4 WRITE !,?((IOM-12)\2),$$FMTE^XLFDT(DT,"D")
+5 WRITE !!
+6 QUIT
+7 ;
PAUSE ;
+1 ;Description: Screen pause. Sets QUIT=1 if user decides to quit.
+2 ;
+3 NEW DIR,X,Y
+4 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+5 SET DIR(0)="E"
DO ^DIR
+6 IF '(+Y)
SET QUIT=1
+7 QUIT
+8 ;
PART1 ;
+1 ;Description: Prints statistics for enrolled veterans.
+2 ;
+3 NEW AMOUNT,TOTAL,STATUS,PRIORITY,CATEGORY,TOTCAT
+4 WRITE !!,"CURRENTLY ENROLLED VETERANS AND VETERANS WITH PENDING APPLICATIONS",!!
+5 WRITE ?59,"Enrolled",?75,"Not Enrolled",?97,"In Process",!
+6 SET TOTAL=0
+7 SET PRIORITY=""
+8 FOR
SET PRIORITY=$ORDER(STATS("PRI",PRIORITY))
if PRIORITY=""
QUIT
Begin DoDot:1
+9 SET AMOUNT=+$GET(STATS("PRI",PRIORITY))
+10 if PRIORITY=0
DO LINE(" NO Priority Group: "_" "_$$F(AMOUNT))
+11 if PRIORITY'=0
DO LINE(" Priority Group "_$SELECT($LENGTH(PRIORITY)=1:PRIORITY_" : ",1:$EXTRACT(PRIORITY)_$EXTRACT(PRIORITY,2)_" : ")_$$F(AMOUNT))
+12 DO CATEGORY(1)
+13 SET TOTAL=TOTAL+AMOUNT
End DoDot:1
if QUIT
QUIT
+14 if QUIT
QUIT
+15 DO LINE(" =====================================")
+16 if QUIT
QUIT
+17 DO LINE(" Total: "_$$F(TOTAL))
+18 DO CATEGORY(0)
+19 if QUIT
QUIT
+20 WRITE !!
+21 SET (TOTAL,STATUS)=0
+22 FOR
SET STATUS=$ORDER(STATS("STATUS",STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+23 SET AMOUNT=+STATS("STATUS",STATUS)
+24 DO LINE($$LJ^XLFSTR(" "_$EXTRACT($$STATUS(STATUS),1,45)_" Status:",54)_$$F(AMOUNT))
+25 SET TOTAL=TOTAL+(AMOUNT)
End DoDot:1
if QUIT
QUIT
+26 if QUIT
QUIT
+27 DO LINE(" ==============================================================")
+28 if QUIT
QUIT
+29 DO LINE($$LJ^XLFSTR(" Total:",54)_$$F(TOTAL))
+30 QUIT
+31 ;
PART2 ;
+1 ;Description: Prints statistics for veterans not enrolled.
+2 ;
+3 NEW AMOUNT,STATUS,PRIORITY,TOTAL
+4 DO LINE(" ")
+5 DO LINE(" ")
+6 DO LINE("VETERANS NOT ENROLLED WITH INPATIENT OR OUTPATIENT ACTIVITY SINCE "_$$FMTE^XLFDT(INDATE,"D"))
+7 DO LINE(" ")
+8 SET TOTAL=0
+9 FOR STATUS=3:1:9
Begin DoDot:1
+10 SET AMOUNT=$GET(STATS("NOT ENROLLED","STATUS",STATUS))
+11 DO LINE($$LJ^XLFSTR(" "_$$STATUS(STATUS)_" Status:",40)_$$F(AMOUNT))
+12 SET TOTAL=TOTAL+(AMOUNT)
End DoDot:1
if QUIT
QUIT
+13 if QUIT
QUIT
+14 DO LINE(" ================================================")
+15 if QUIT
QUIT
+16 DO LINE($$LJ^XLFSTR(" Total:",40)_$$F(TOTAL))
+17 QUIT
+18 ;
F(X) ;
+1 ;Description: Formats X, a number, used as standard format for report.
+2 ;
+3 QUIT $JUSTIFY($FNUMBER(X,","),12)
+4 ;
STATUS(STATUS) ;
+1 ;Description: Returns status name.
+2 ;
+3 QUIT $$LOWER^VALM1($$EXT^DGENU("STATUS",STATUS))
+4 ;
CATEGORY(FLG) ;
+1 ;Displays category totals for each priority
+2 ; Input:
+3 ; FLG - 0 Displays category totals for each priority
+4 ; 1 Displays total categorys
+5 ;
+6 NEW CATEGORY
+7 FOR CATEGORY="E","N","P"
Begin DoDot:1
+8 WRITE ?$SELECT(CATEGORY="E":55,CATEGORY="N":75,1:95)
+9 IF FLG
Begin DoDot:2
+10 if +$GET(STATS("PRI",PRIORITY,"CAT",CATEGORY))=0
QUIT
+11 WRITE $$F(STATS("PRI",PRIORITY,"CAT",CATEGORY))
+12 SET TOTCAT(CATEGORY)=$GET(TOTCAT(CATEGORY))+STATS("PRI",PRIORITY,"CAT",CATEGORY)
End DoDot:2
QUIT
+13 if +$GET(TOTCAT(CATEGORY))=0
QUIT
+14 WRITE $$F(TOTCAT(CATEGORY))
End DoDot:1
+15 QUIT
