source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSCW.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.5 KB
RevLine 
[613]1GMTSCW ; SLC/DJP - TIU CWD Component driver ; 04/11/2001
2 ;;2.7;Health Summary;**12,45**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3155 call MAIN^TIULAPI
6 ; DBIA 10006 call ^DIC
7 ;
8 ; CWAD - Clinical Warnings and Advanced Directives
9CW ; Clinical Warning Display
10 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="CLINICAL WARNING",GMTSTIUC="C"
11 S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""DC""" D ^DIC I Y>0 S TIUTYPE=+Y D MAIN
12 Q
13CN ; Crisis Note Display
14 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="CRISIS NOTE",GMTSTIUC="C"
15 S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""DC""" D ^DIC I Y>0 S TIUTYPE=+Y D MAIN
16 Q
17CD ; Advance Directive Display
18 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="ADVANCE DIRECTIVE",GMTSTIUC="C"
19 S DIC="^TIU(8925.1,",DIC(0)="X",DIC("S")="I $P($G(^(0)),U,4)=""DC""" D ^DIC I Y>0 S TIUTYPE=+Y D MAIN
20 Q
21 ;
22MAIN ; Control branching
23 N ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED
24 N COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT
25 N GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ,GMTSJ,GMTSK
26 N GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA
27 N I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC,TYPE,X,Y
28 K ^TMP("TIU",$J) D MAIN^TIULAPI(DFN,TIUTYPE,"ALL",GMTS1,GMTS2,GMTSNDM,1)
29 Q:'$D(^TMP("TIU",$J)) D PNOTE^GMTSPN Q
Note: See TracBrowser for help on using the repository browser.