GMTSONE ; HIN/GWB,RTK - Oncology Health Summary Comp ; 1/27/16 8:52am
;;2.7;Health Summary;**36,35,42,54,56,72,117**;Oct 20, 1995;Build 2
;
; External References
; DBIA 2924 ^ONCO(160,
; DBIA 2888 ^ONCO(165.5,
; DBIA 10015 ^UTILITY("DIQ1"
; DBIA 2056 GETS^DIQ (file 160 and 165,5)
; DBIA 10015 EN^DIQ1 (file 165.5)
;
; Variables Used but not NEWed or KILLed
; DFN, GMTSQIT
;
K ^UTILITY("DIQ1",$J),ONC
N CNT,DA,DIC,DIQ,DR,HSFLAG,IEN,IEN1,IEN2,LINE,LOS,NOP,ONC,PTIEN
N SUB,SUBCNT,SUBIEN,SUBLET,TSIEN,TXT,TXT1,TXT2
Q:'$D(^ONCO(160,"B",DFN_";DPT(")) S PTIEN=$O(^ONCO(160,"B",DFN_";DPT(",0))
S SUB="abcdefghijklmnopqrstuvwxyz",HSFLAG=1
S IEN=0 F S IEN=$O(^ONCO(165.5,"C",PTIEN,IEN)) Q:IEN="" D
. S DIC="^ONCO(165.5,",DR=".04;3;12;13;20;22;22.3;24;29;30;32;33;37.1;37.2;37.3;38;50;50.3;51:51.5;53:53.4;54:54.4;55:55.4;58:58.7;57:57.4;75;85;86;87;88;91;95;125;139:139.7;153:153.3;346;442;443;560;2000"
. S DA=IEN D EN^DIQ1
. S DR="20.1;28;29.2;30.2;29.1;31.1;32.1;34.3:34.4;44.1;44.2;44.3;44.4;44.5;44.6;155;160:168;200"
. S DA=IEN D EN^DIQ1
. S DR="3",DIQ(0)="I" D EN^DIQ1
. D GETS^DIQ(165.5,IEN_",","60*","N","ONC")
S IEN=0 F S IEN=$O(ONC(165.51,IEN)) Q:IEN'>0 D
. S IEN1=$P(IEN,",",2)
. S IEN2=$P(IEN,",",1)
. M ONC("SUB",IEN1,IEN2)=ONC(165.51,IEN)
. K IEN1,IEN2
K ONC(165.51)
D GETS^DIQ(160,PTIEN_",","16;400*","N","ONC")
D ^GMTSONE1
K ^UTILITY("DIQ1",$J),CNT,DA,DIC,DIQ,DR,HSFLAG,IEN,LINE,LOS,NOP
K ONC,PTIEN,SUB,SUBIEN,SUBCNT,SUBLET,TSIEN,TXT,TXT1,TXT2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSONE 1654 printed Dec 13, 2024@01:58:31 Page 2
GMTSONE ; HIN/GWB,RTK - Oncology Health Summary Comp ; 1/27/16 8:52am
+1 ;;2.7;Health Summary;**36,35,42,54,56,72,117**;Oct 20, 1995;Build 2
+2 ;
+3 ; External References
+4 ; DBIA 2924 ^ONCO(160,
+5 ; DBIA 2888 ^ONCO(165.5,
+6 ; DBIA 10015 ^UTILITY("DIQ1"
+7 ; DBIA 2056 GETS^DIQ (file 160 and 165,5)
+8 ; DBIA 10015 EN^DIQ1 (file 165.5)
+9 ;
+10 ; Variables Used but not NEWed or KILLed
+11 ; DFN, GMTSQIT
+12 ;
+1 KILL ^UTILITY("DIQ1",$JOB),ONC
+2 NEW CNT,DA,DIC,DIQ,DR,HSFLAG,IEN,IEN1,IEN2,LINE,LOS,NOP,ONC,PTIEN
+3 NEW SUB,SUBCNT,SUBIEN,SUBLET,TSIEN,TXT,TXT1,TXT2
+4 if '$DATA(^ONCO(160,"B",DFN_";DPT("))
QUIT
SET PTIEN=$ORDER(^ONCO(160,"B",DFN_";DPT(",0))
+5 SET SUB="abcdefghijklmnopqrstuvwxyz"
SET HSFLAG=1
+6 SET IEN=0
FOR
SET IEN=$ORDER(^ONCO(165.5,"C",PTIEN,IEN))
if IEN=""
QUIT
Begin DoDot:1
+7 SET DIC="^ONCO(165.5,"
SET DR=".04;3;12;13;20;22;22.3;24;29;30;32;33;37.1;37.2;37.3;38;50;50.3;51:51.5;53:53.4;54:54.4;55:55.4;58:58.7;57:57.4;75;85;86;87;88;91;95;125;139:139.7;153:153.3;346;442;443;560;2000"
+8 SET DA=IEN
DO EN^DIQ1
+9 SET DR="20.1;28;29.2;30.2;29.1;31.1;32.1;34.3:34.4;44.1;44.2;44.3;44.4;44.5;44.6;155;160:168;200"
+10 SET DA=IEN
DO EN^DIQ1
+11 SET DR="3"
SET DIQ(0)="I"
DO EN^DIQ1
+12 DO GETS^DIQ(165.5,IEN_",","60*","N","ONC")
End DoDot:1
+13 SET IEN=0
FOR
SET IEN=$ORDER(ONC(165.51,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+14 SET IEN1=$PIECE(IEN,",",2)
+15 SET IEN2=$PIECE(IEN,",",1)
+16 MERGE ONC("SUB",IEN1,IEN2)=ONC(165.51,IEN)
+17 KILL IEN1,IEN2
End DoDot:1
+18 KILL ONC(165.51)
+19 DO GETS^DIQ(160,PTIEN_",","16;400*","N","ONC")
+20 DO ^GMTSONE1
+21 KILL ^UTILITY("DIQ1",$JOB),CNT,DA,DIC,DIQ,DR,HSFLAG,IEN,LINE,LOS,NOP
+22 KILL ONC,PTIEN,SUB,SUBIEN,SUBCNT,SUBLET,TSIEN,TXT,TXT1,TXT2
+23 QUIT
