- 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 Mar 13, 2025@21:30:26 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
