source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCODGR.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1ONCODGR ;WASH ISC/SRR-DD for GRADE: #24;file 165.5 ;2/9/93 15:11
2 ;;2.11;ONCOLOGY;;Mar 07, 1995
3 ;
4SS S S=$P(^ONCO(165.5,D0,0),U) S SS=$S(S=63:62,(S>65&(S<70)):68,S=40:62,S'=62:36,1:S)
5 Q
6IN ;CHECK INPUT GRADE #24;165.5
7 D SS S Y=$O(^ONCO(164.2,SS,"G","X",X,0)) I Y="" K X Q
8 S Y=^ONCO(164.2,SS,"G",Y,0) W ?15,$P(Y,U)_" "_$P(Y,U,2) K Y G EX
9 K X,Y G EX
10 Q
11 ;
12OT ;OUTPUT TRANSFORM for N0 CANCER-DIRECTED/SITE SPECIFIC surgery #58.1
13 Q:Y="" D SS S X=$O(^ONCO(164.2,SS,"G","X",Y,0)) G EX:X="" S X=^ONCO(164.2,SS,"G",X,0),Y=$P(X,U)_" "_$P(X,U,2) G EX
14 ;
15HP ;EXTENDED HELP for GRADE #24 (FILE 165.5)
16 K DIR I X="??" S XQH="ONCO GRADE" D EN^XQH W !!
17 D SS S Y=0 F S Y=$O(^ONCO(164.2,SS,"G",Y)) Q:Y="B" S X=^(Y,0) W ?10,$P(X,U,3)_"-"_$P(X,U)_" "_$P(X,U,2),!
18 W !?5,"Enter a 1-digit code from above list.",! G EX
19 ;
20GA() ; Computation for GRADE ABBREVIATION Field (#25)
21 ; in ONCOLOGY PRIMARY File (#165.5)
22 ;
23 S X=$P($G(^ONCO(165.5,D0,2)),U,5)
24 S X=$S(X=1:"WD",X=2:"MD",X=3:"PD",X=4:"ANA",X=5:"T-CELL",X=6:"B-CELL",X=7:"NULL-CELL",1:"")
25 Q X
26 ;
27EX ;EXIT
28 K SS Q
Note: See TracBrowser for help on using the repository browser.