- ONCODSP1 ;HINES IRMFO/RTK-ANNUAL SUMMARY REPORT DISPLAY ;5/6/96 15:11
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- U IO S FIRST="1ST",PRTC=1
- S (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- S (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- S (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8)=0
- S (TT9,TT10,TT11,TT12,TT13,TT14,TT15,TT16,TT17)=0
- F IEN=0:0 S IEN=$O(^TMP($J,"ANNSUM",IEN)) Q:IEN'>0 S CC=$G(^TMP($J,"ANNSUM",IEN,"CC")),RS=$G(^TMP($J,"ANNSUM",IEN,"RS")),SG=$G(^TMP($J,"ANNSUM",IEN,"SG")),ZNODE=$G(^TMP($J,"ANNSUM",IEN,0)),TOPGP=$P(ZNODE,"^",2) D
- .Q:PRTC=0
- .I FIRST="1ST" D HDR S FIRST=""
- .I TOPGP="C00" S PTR=$P(ZNODE,"^",4) W !?43,"|",?82,"|",!?5,"System: " I PTR'="" W $G(^ONCO(164.14,PTR,0)),?82,"|"
- .I "C15^C30^C40^C42^C44^C47^C48^C49^C50^C51^C60^C64^C69^C73^C76^C77^C80"[TOPGP D
- ..S DS="-----" W !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- ..W !,"SUBTOTAL",?24,COL1,?30,COL2,?36,COL3,?43,"|",?45,COL4,?51,COL5,?57,COL6
- ..W ?63,COL7,?69,COL8,?75,COL9,?82,"|",?85,COL10,?91,COL11,?97,COL12
- ..W ?103,COL13,?109,COL14,?115,COL15,?121,COL16,?127,COL17
- ..S TT1=TT1+COL1,TT2=TT2+COL2,TT3=TT3+COL3,TT4=TT4+COL4,TT5=TT5+COL5
- ..S TT6=TT6+COL6,TT7=TT7+COL7,TT8=TT8+COL8,TT9=TT9+COL9,TT10=TT10+COL10
- ..S TT11=TT11+COL11,TT12=TT12+COL12,TT13=TT13+COL13,TT14=TT14+COL14
- ..S TT15=TT15+COL15,TT16=TT16+COL16,TT17=TT17+COL17
- ..S (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- ..S (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- ..S PTR=$P(ZNODE,"^",4) W !?43,"|",?82,"|",!,?5,"System: " I PTR'="" W $G(^ONCO(164.14,PTR,0)) W:$L($G(^ONCO(164.14,PTR,0)))<28 ?43,"|" W ?82,"|"
- ..Q
- .I ZNODE'="" W !,$E($P(ZNODE,"^"),1,22)
- .I $D(CC) D
- ..W ?24,$P(CC,"^",1),?30,$P(CC,"^",2),?36,$P(CC,"^",3)
- ..S COL1=COL1+$P(CC,"^",1),COL2=COL2+$P(CC,"^",2),COL3=COL3+$P(CC,"^",3)
- .I $D(RS) D
- ..W ?43,"|",?45,$P(RS,"^",1),?51,$P(RS,"^",2),?57,$P(RS,"^",3),?63,$P(RS,"^",4),?69,$P(RS,"^",5),?75,$P(RS,"^",6)
- ..S COL4=COL4+$P(RS,"^",1),COL5=COL5+$P(RS,"^",2),COL6=COL6+$P(RS,"^",3),COL7=COL7+$P(RS,"^",4),COL8=COL8+$P(RS,"^",5),COL9=COL9+$P(RS,"^",6)
- .I $D(SG) D
- ..W ?82,"|",?85,$P(SG,"^",1),?91,$P(SG,"^",2),?97,$P(SG,"^",3),?103,$P(SG,"^",4),?109,$P(SG,"^",5),?115,$P(SG,"^",6),?121,$P(SG,"^",7),?127,$P(SG,"^",8)
- ..S COL10=COL10+$P(SG,"^",1),COL11=COL11+$P(SG,"^",2),COL12=COL12+$P(SG,"^",3),COL13=COL13+$P(SG,"^",4),COL14=COL14+$P(SG,"^",5),COL15=COL15+$P(SG,"^",6),COL16=COL16+$P(SG,"^",7),COL17=COL17+$P(SG,"^",8)
- .I TOPGP="C80" D
- ..S DS="-----" W !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- ..W !,"SUBTOTAL",?24,COL1,?30,COL2,?36,COL3,?43,"|",?45,COL4,?51,COL5,?57,COL6
- ..W ?63,COL7,?69,COL8,?75,COL9,?82,"|",?85,COL10,?91,COL11,?97,COL12
- ..W ?103,COL13,?109,COL14,?115,COL15,?121,COL16,?127,COL17
- ..S TT1=TT1+COL1,TT2=TT2+COL2,TT3=TT3+COL3,TT4=TT4+COL4,TT5=TT5+COL5
- ..S TT6=TT6+COL6,TT7=TT7+COL7,TT8=TT8+COL8,TT9=TT9+COL9,TT10=TT10+COL10
- ..S TT11=TT11+COL11,TT12=TT12+COL12,TT13=TT13+COL13,TT14=TT14+COL14
- ..S TT15=TT15+COL15,TT16=TT16+COL16,TT17=TT17+COL17
- ..S (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- ..S (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- ..Q
- .I $Y>(IOSL-6) D:$E(IOST,1)="C" PRTC Q:PRTC=0 D HDR
- Q:PRTC=0
- S DS="-----" W !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- W !,"TOTAL",?24,TT1,?30,TT2,?36,TT3,?43,"|",?45,TT4,?51,TT5,?57,TT6,?63,TT7
- W ?69,TT8,?75,TT9,?82,"|",?85,TT10,?91,TT11,?97,TT12,?103,TT13,?109,TT14
- W ?115,TT15,?121,TT16,?127,TT17
- K COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10,COL11,COL12,COL13
- K COL14,COL15,COL16,COL17,TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11
- K TT12,TT13,TT14,TT15,TT16,TT17
- K CC,DS,FIRST,IEN,LINES,PRTC,PTR,RS,SG,TOPGP,ZNODE
- D ^%ZISC Q
- HDR ;HEADER - PRINT THIS FOR EACH NEW PAGE
- W:$Y>0 @IOF
- S LINES="",$P(LINES,"_",75)=""
- W "ANNUAL SUMMARY REPORT: ",$G(^TMP($J,"ANNSUM","YR")) D NOW^%DTC S Y=% D DD^%DT W " ",Y,!
- W "SITE:",?24,"TOT#",?30,"ANAL",?36,"NON",?43,"|",?45,"W-M",?51,"W-F",?57,"B-M",?63,"B-F",?69,"O-M",?75,"O-F",?82,"|",?85,"0",?91,"I",?97,"II",?103,"III",?109,"IV",?115,"U",?121,"NA",?127,"INC"
- W !,$E(LINES,1,43),"|",$E(LINES,1,38),"|",$E(LINES,1,48)
- Q
- PRTC W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S PRTC=Y S:$D(DIRUT) PRTC=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODSP1 4538 printed Feb 18, 2025@23:51:21 Page 2
- ONCODSP1 ;HINES IRMFO/RTK-ANNUAL SUMMARY REPORT DISPLAY ;5/6/96 15:11
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 USE IO
- SET FIRST="1ST"
- SET PRTC=1
- +3 SET (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- +4 SET (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- +5 SET (TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8)=0
- +6 SET (TT9,TT10,TT11,TT12,TT13,TT14,TT15,TT16,TT17)=0
- +7 FOR IEN=0:0
- SET IEN=$ORDER(^TMP($JOB,"ANNSUM",IEN))
- if IEN'>0
- QUIT
- SET CC=$GET(^TMP($JOB,"ANNSUM",IEN,"CC"))
- SET RS=$GET(^TMP($JOB,"ANNSUM",IEN,"RS"))
- SET SG=$GET(^TMP($JOB,"ANNSUM",IEN,"SG"))
- SET ZNODE=$GET(^TMP($JOB,"ANNSUM",IEN,0))
- SET TOPGP=$PIECE(ZNODE,"^",2)
- Begin DoDot:1
- +8 if PRTC=0
- QUIT
- +9 IF FIRST="1ST"
- DO HDR
- SET FIRST=""
- +10 IF TOPGP="C00"
- SET PTR=$PIECE(ZNODE,"^",4)
- WRITE !?43,"|",?82,"|",!?5,"System: "
- IF PTR'=""
- WRITE $GET(^ONCO(164.14,PTR,0)),?82,"|"
- +11 IF "C15^C30^C40^C42^C44^C47^C48^C49^C50^C51^C60^C64^C69^C73^C76^C77^C80"[TOPGP
- Begin DoDot:2
- +12 SET DS="-----"
- WRITE !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- +13 WRITE !,"SUBTOTAL",?24,COL1,?30,COL2,?36,COL3,?43,"|",?45,COL4,?51,COL5,?57,COL6
- +14 WRITE ?63,COL7,?69,COL8,?75,COL9,?82,"|",?85,COL10,?91,COL11,?97,COL12
- +15 WRITE ?103,COL13,?109,COL14,?115,COL15,?121,COL16,?127,COL17
- +16 SET TT1=TT1+COL1
- SET TT2=TT2+COL2
- SET TT3=TT3+COL3
- SET TT4=TT4+COL4
- SET TT5=TT5+COL5
- +17 SET TT6=TT6+COL6
- SET TT7=TT7+COL7
- SET TT8=TT8+COL8
- SET TT9=TT9+COL9
- SET TT10=TT10+COL10
- +18 SET TT11=TT11+COL11
- SET TT12=TT12+COL12
- SET TT13=TT13+COL13
- SET TT14=TT14+COL14
- +19 SET TT15=TT15+COL15
- SET TT16=TT16+COL16
- SET TT17=TT17+COL17
- +20 SET (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- +21 SET (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- +22 SET PTR=$PIECE(ZNODE,"^",4)
- WRITE !?43,"|",?82,"|",!,?5,"System: "
- IF PTR'=""
- WRITE $GET(^ONCO(164.14,PTR,0))
- if $LENGTH($GET(^ONCO(164.14,PTR,0)))<28
- WRITE ?43,"|"
- WRITE ?82,"|"
- +23 QUIT
- End DoDot:2
- +24 IF ZNODE'=""
- WRITE !,$EXTRACT($PIECE(ZNODE,"^"),1,22)
- +25 IF $DATA(CC)
- Begin DoDot:2
- +26 WRITE ?24,$PIECE(CC,"^",1),?30,$PIECE(CC,"^",2),?36,$PIECE(CC,"^",3)
- +27 SET COL1=COL1+$PIECE(CC,"^",1)
- SET COL2=COL2+$PIECE(CC,"^",2)
- SET COL3=COL3+$PIECE(CC,"^",3)
- End DoDot:2
- +28 IF $DATA(RS)
- Begin DoDot:2
- +29 WRITE ?43,"|",?45,$PIECE(RS,"^",1),?51,$PIECE(RS,"^",2),?57,$PIECE(RS,"^",3),?63,$PIECE(RS,"^",4),?69,$PIECE(RS,"^",5),?75,$PIECE(RS,"^",6)
- +30 SET COL4=COL4+$PIECE(RS,"^",1)
- SET COL5=COL5+$PIECE(RS,"^",2)
- SET COL6=COL6+$PIECE(RS,"^",3)
- SET COL7=COL7+$PIECE(RS,"^",4)
- SET COL8=COL8+$PIECE(RS,"^",5)
- SET COL9=COL9+$PIECE(RS,"^",6)
- End DoDot:2
- +31 IF $DATA(SG)
- Begin DoDot:2
- +32 WRITE ?82,"|",?85,$PIECE(SG,"^",1),?91,$PIECE(SG,"^",2),?97,$PIECE(SG,"^",3),?103,$PIECE(SG,"^",4),?109,$PIECE(SG,"^",5),?115,$PIECE(SG,"^",6),?121,$PIECE(SG,"^",7),?127,$PIECE(SG,"^",8)
- +33 SET COL10=COL10+$PIECE(SG,"^",1)
- SET COL11=COL11+$PIECE(SG,"^",2)
- SET COL12=COL12+$PIECE(SG,"^",3)
- SET COL13=COL13+$PIECE(SG,"^",4)
- SET COL14=COL14+$PIECE(SG,"^",5)
- SET COL15=COL15+$PIECE(SG,"^",6)
- SET COL16=COL16+$PIECE(SG,"^",7)
- SET COL17=COL17+$PIECE(SG,"^",8)
- End DoDot:2
- +34 IF TOPGP="C80"
- Begin DoDot:2
- +35 SET DS="-----"
- WRITE !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- +36 WRITE !,"SUBTOTAL",?24,COL1,?30,COL2,?36,COL3,?43,"|",?45,COL4,?51,COL5,?57,COL6
- +37 WRITE ?63,COL7,?69,COL8,?75,COL9,?82,"|",?85,COL10,?91,COL11,?97,COL12
- +38 WRITE ?103,COL13,?109,COL14,?115,COL15,?121,COL16,?127,COL17
- +39 SET TT1=TT1+COL1
- SET TT2=TT2+COL2
- SET TT3=TT3+COL3
- SET TT4=TT4+COL4
- SET TT5=TT5+COL5
- +40 SET TT6=TT6+COL6
- SET TT7=TT7+COL7
- SET TT8=TT8+COL8
- SET TT9=TT9+COL9
- SET TT10=TT10+COL10
- +41 SET TT11=TT11+COL11
- SET TT12=TT12+COL12
- SET TT13=TT13+COL13
- SET TT14=TT14+COL14
- +42 SET TT15=TT15+COL15
- SET TT16=TT16+COL16
- SET TT17=TT17+COL17
- +43 SET (COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8)=0
- +44 SET (COL9,COL10,COL11,COL12,COL13,COL14,COL15,COL16,COL17)=0
- +45 QUIT
- End DoDot:2
- +46 IF $Y>(IOSL-6)
- if $EXTRACT(IOST,1)="C"
- DO PRTC
- if PRTC=0
- QUIT
- DO HDR
- End DoDot:1
- +47 if PRTC=0
- QUIT
- +48 SET DS="-----"
- WRITE !,?24,DS,?30,DS,?36,DS,?43,"|",?45,DS,?51,DS,?57,DS,?63,DS,?69,DS,?75,DS,?82,"|",?85,DS,?91,DS,?97,DS,?103,DS,?109,DS,?115,DS,?121,DS,?127,DS
- +49 WRITE !,"TOTAL",?24,TT1,?30,TT2,?36,TT3,?43,"|",?45,TT4,?51,TT5,?57,TT6,?63,TT7
- +50 WRITE ?69,TT8,?75,TT9,?82,"|",?85,TT10,?91,TT11,?97,TT12,?103,TT13,?109,TT14
- +51 WRITE ?115,TT15,?121,TT16,?127,TT17
- +52 KILL COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9,COL10,COL11,COL12,COL13
- +53 KILL COL14,COL15,COL16,COL17,TT1,TT2,TT3,TT4,TT5,TT6,TT7,TT8,TT9,TT10,TT11
- +54 KILL TT12,TT13,TT14,TT15,TT16,TT17
- +55 KILL CC,DS,FIRST,IEN,LINES,PRTC,PTR,RS,SG,TOPGP,ZNODE
- +56 DO ^%ZISC
- QUIT
- HDR ;HEADER - PRINT THIS FOR EACH NEW PAGE
- +1 if $Y>0
- WRITE @IOF
- +2 SET LINES=""
- SET $PIECE(LINES,"_",75)=""
- +3 WRITE "ANNUAL SUMMARY REPORT: ",$GET(^TMP($JOB,"ANNSUM","YR"))
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- WRITE " ",Y,!
- +4 WRITE "SITE:",?24,"TOT#",?30,"ANAL",?36,"NON",?43,"|",?45,"W-M",?51,"W-F",?57,"B-M",?63,"B-F",?69,"O-M",?75,"O-F",?82,"|",?85,"0",?91,"I",?97,"II",?103,"III",?109,"IV",?115,"U",?121,"NA",?127,"INC"
- +5 WRITE !,$EXTRACT(LINES,1,43),"|",$EXTRACT(LINES,1,38),"|",$EXTRACT(LINES,1,48)
- +6 QUIT
- PRTC WRITE !
- KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
- SET DIR(0)="E"
- DO ^DIR
- SET PRTC=Y
- if $DATA(DIRUT)
- SET PRTC=0
- +1 QUIT