ONCOSCT3 ;WASH ISC/SRR,MLH-ASCII OUTPUT ;8/21/93 11:17
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
OUTPUT ;IN ^TMP($J,"CLAB",'Column Alpha Order')=COLUMN LABEL
; ^TMP($J,"RLAB", Row Number)= ROW LABEL
; ,"COL", Column number) = Column Alpha
; "CSUM", 'Column Alpha') = column sum
; "RSUM:, 'Row Number) = Row sum
;^TMP($J,"CELL",Row Number,Column Alpha code)= Total for cell ^(x,y)
;
AS K X S J=2,Q="""",C=",",B=Q_Q,X(1)=B,X(2)=Q_$P(ROWDD,U)_Q
S X=-1 F S X=$O(^TMP($J,"CLAB",X)) Q:X="" S VA=^(X) D DATA
S R=0 F S R=$O(^TMP($J,"RLAB",R)) Q:R="" S J=J+1,X(J)=Q_^(R)_Q D
.S TC=0,CO=0 F S CO=$O(^TMP($J,"COL",CO)) Q:CO="" S V=^(CO),TC=TC+1,T=$G(^TMP($J,"CELL",R,V)),T=$S(T="":0,1:T),X(J)=X(J)_C_T
Q:J=2 S J=J+1,X(J)=B F K=1:1:TC S X(J)=X(J)_C_B
B S XMSUB=$P(COLDD,U,1)_" VS "_$P(ROWDD,U,1) ;B
M S XMDUZ=DUZ D XMZ^XMA2
S L=0
A S L=L+1 I $D(X(L)) S X=X(L) I $L(X),$L(X)'>255 S ^XMB(3.9,XMZ,2,L,0)=X G A
;String length too long
;
;NO DATA RETURNED SET ZERO NODE
S DA=XMZ,DIE=3.9,DR="1.7///P;1.95///Y" D ^DIE
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_L_"^"_L_"^"_DT
;S XMDUN="SENDER"
S XMY(DUZ)="",XMY($P(^VA(200,DUZ,0),U))=""
D ENT1^XMD ; CALL for delivery
;D ^XMD ; formerly NNEW^XMA
Q
;
DATA ;CREATE STRING
D ;CHECK LENGTH
Q:X(1)["END" S NVA=C_Q_VA_Q,SL=$L(NVA)+$L(X(1)) I SL>245 S X(1)=X(1)_C_Q_"END" Q
S X(1)=X(1)_NVA,X(2)=X(2)_C_B
Q
EX ;Exit and kill
K XMX,XMSUB,XMY,L,XMZ,V,CO,TC,T,VA,B,Q,J,X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSCT3 1478 printed Nov 22, 2024@17:35:41 Page 2
ONCOSCT3 ;WASH ISC/SRR,MLH-ASCII OUTPUT ;8/21/93 11:17
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
OUTPUT ;IN ^TMP($J,"CLAB",'Column Alpha Order')=COLUMN LABEL
+1 ; ^TMP($J,"RLAB", Row Number)= ROW LABEL
+2 ; ,"COL", Column number) = Column Alpha
+3 ; "CSUM", 'Column Alpha') = column sum
+4 ; "RSUM:, 'Row Number) = Row sum
+5 ;^TMP($J,"CELL",Row Number,Column Alpha code)= Total for cell ^(x,y)
+6 ;
AS KILL X
SET J=2
SET Q=""""
SET C=","
SET B=Q_Q
SET X(1)=B
SET X(2)=Q_$PIECE(ROWDD,U)_Q
+1 SET X=-1
FOR
SET X=$ORDER(^TMP($JOB,"CLAB",X))
if X=""
QUIT
SET VA=^(X)
DO DATA
+2 SET R=0
FOR
SET R=$ORDER(^TMP($JOB,"RLAB",R))
if R=""
QUIT
SET J=J+1
SET X(J)=Q_^(R)_Q
Begin DoDot:1
+3 SET TC=0
SET CO=0
FOR
SET CO=$ORDER(^TMP($JOB,"COL",CO))
if CO=""
QUIT
SET V=^(CO)
SET TC=TC+1
SET T=$GET(^TMP($JOB,"CELL",R,V))
SET T=$SELECT(T="":0,1:T)
SET X(J)=X(J)_C_T
End DoDot:1
+4 if J=2
QUIT
SET J=J+1
SET X(J)=B
FOR K=1:1:TC
SET X(J)=X(J)_C_B
B ;B
SET XMSUB=$PIECE(COLDD,U,1)_" VS "_$PIECE(ROWDD,U,1)
M SET XMDUZ=DUZ
DO XMZ^XMA2
+1 SET L=0
A SET L=L+1
IF $DATA(X(L))
SET X=X(L)
IF $LENGTH(X)
IF $LENGTH(X)'>255
SET ^XMB(3.9,XMZ,2,L,0)=X
GOTO A
+1 ;String length too long
+2 ;
+3 ;NO DATA RETURNED SET ZERO NODE
+4 SET DA=XMZ
SET DIE=3.9
SET DR="1.7///P;1.95///Y"
DO ^DIE
+5 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_L_"^"_L_"^"_DT
+6 ;S XMDUN="SENDER"
+7 SET XMY(DUZ)=""
SET XMY($PIECE(^VA(200,DUZ,0),U))=""
+8 ; CALL for delivery
DO ENT1^XMD
+9 ;D ^XMD ; formerly NNEW^XMA
+10 QUIT
+11 ;
DATA ;CREATE STRING
D ;CHECK LENGTH
+1 if X(1)["END"
QUIT
SET NVA=C_Q_VA_Q
SET SL=$LENGTH(NVA)+$LENGTH(X(1))
IF SL>245
SET X(1)=X(1)_C_Q_"END"
QUIT
+2 SET X(1)=X(1)_NVA
SET X(2)=X(2)_C_B
+3 QUIT
EX ;Exit and kill
+1 KILL XMX,XMSUB,XMY,L,XMZ,V,CO,TC,T,VA,B,Q,J,X
