source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRCDCPX.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1IMRCDCPX ;ISC-SF/JLI-FUNCTION HANDLING FOR PRINTING CDC FORMS ;5/22/95 12:04
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3 ; called from IMRCDP* routines & from IMR function calls
4VAL(FLD,X) ; FLD IS FIELD TO BE TESTED, X IS VALUE TO BE TESTED AGAINST
5 N Y S Y="?" I IMRPT="" S Y="" G EXIT
6 I $D(^DD(158,FLD,0)) S Y=$P(^(0),U,4) D
7 .I $P(Y,";")'=" " S Y=$P($G(^IMR(158,IMRPT,$P(Y,";"))),U,+$P(Y,";",2)) S:Y'>0 Y=$S(Y="D":1,Y="P":2,Y="N":0,Y="Y":1,1:Y) Q
8 .S Y=X S X=$$GET1^DIQ(158,IMRPT,FLD,"E") S:X="MALE" X=1 S:X="FEMALE" X=2 Q
9 S Y=$S(Y=X:Y,Y="?":"?",FLD=112.06:" ",1:" ")
10EXIT Q Y
11DAT(FLD) ; FLD IS FIELD TO BE DISPLAYED AS MO YR
12 N Y S Y="?" I IMRPT="" S Y="" G EXIT1
13 I $D(^DD(158,FLD,0)) S Y=$P(^(0),U,4) D
14 .I $P(Y,";")'=" " S Y=$P($G(^IMR(158,IMRPT,$P(Y,";"))),U,+$P(Y,";",2)) Q
15 .S X=$$GET1^DIQ(158,IMRPT,FLD,"E") S Y=X Q
16 S Y=$S(Y="":" ",$E(Y,1,7)?7N:$E(Y,4,5)_" "_$E(Y,2,3),1:"?? ??")
17EXIT1 Q Y
18FIELD(FILE,ENTRY,FLD,FLG) ; FLD will contain the data of the file.
19 S Y=$$GET1^DIQ(FILE,ENTRY,FLD,FLG)
20 Q Y
Note: See TracBrowser for help on using the repository browser.