GMTSCW.m

GMTSCW ; SLC/DJP - TIU CWD Component driver ; 04/11/2001

 ;;2.7;Health Summary;**12,45**;Oct 20, 1995

 ;                          

 ; External References

 ;    DBIA  3155 call MAIN^TIULAPI

 ;    DBIA 10006 call ^DIC

 ;                        

 ; CWAD - Clinical Warnings and Advanced Directives

CW ;   Clinical Warning Display

 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="CLINICAL WARNING",GMTSTIUC="C"

 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

 Q

CN ;   Crisis Note Display

 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="CRISIS NOTE",GMTSTIUC="C"

 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

 Q

CD ;   Advance Directive Display

 N X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC S TIUFPRIV=1,(TIUNAM,X)="ADVANCE DIRECTIVE",GMTSTIUC="C"

 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

 Q

 ;                                 

MAIN ; Control branching

 N ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED

 N COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT

 N GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ,GMTSJ,GMTSK

 N GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA

 N I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC,TYPE,X,Y

 K ^TMP("TIU",$J) D MAIN^TIULAPI(DFN,TIUTYPE,"ALL",GMTS1,GMTS2,GMTSNDM,1)

 Q:'$D(^TMP("TIU",$J))  D PNOTE^GMTSPN Q

GMTSCW    ; SLC/DJP - TIU CWD Component driver ; 04/11/2001

 +1       ;;2.7;Health Summary;**12,45**;Oct 20, 1995

 +2       ;                          

 +3       ; External References

 +4       ;    DBIA  3155 call MAIN^TIULAPI

 +5       ;    DBIA 10006 call ^DIC

 +6       ;                        

 +7       ; CWAD - Clinical Warnings and Advanced Directives

CW        ;   Clinical Warning Display

 +1        NEW X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC

           SET TIUFPRIV=1

           SET (TIUNAM,X)="CLINICAL WARNING"

           SET GMTSTIUC="C"

 +2        SET DIC="^TIU(8925.1,"

           SET DIC(0)="X"

           SET DIC("S")="I $P($G(^(0)),U,4)=""DC"""

           DO ^DIC

           IF Y>0

               SET TIUTYPE=+Y

               DO MAIN

 +3        QUIT 

CN        ;   Crisis Note Display

 +1        NEW X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC

           SET TIUFPRIV=1

           SET (TIUNAM,X)="CRISIS NOTE"

           SET GMTSTIUC="C"

 +2        SET DIC="^TIU(8925.1,"

           SET DIC(0)="X"

           SET DIC("S")="I $P($G(^(0)),U,4)=""DC"""

           DO ^DIC

           IF Y>0

               SET TIUTYPE=+Y

               DO MAIN

 +3        QUIT 

CD        ;   Advance Directive Display

 +1        NEW X,DIC,TIUTYPE,Y,TIUFPRIV,TIUNAM,GMTSTIUC

           SET TIUFPRIV=1

           SET (TIUNAM,X)="ADVANCE DIRECTIVE"

           SET GMTSTIUC="C"

 +2        SET DIC="^TIU(8925.1,"

           SET DIC(0)="X"

           SET DIC("S")="I $P($G(^(0)),U,4)=""DC"""

           DO ^DIC

           IF Y>0

               SET TIUTYPE=+Y

               DO MAIN

 +3        QUIT 

 +4       ;                                 

MAIN      ; Control branching

 +1        NEW ADATE,ADMIT,ASUB,ATDATE,ATTNDNG,ATTYPE,ATYPE,AUTHOR,CHILD,CONEED

 +2        NEW COSAME,COSGEDBY,COSIG,CURIEN,DISCHG,GMTSA,GMTSAI,GMTSAII,GMTSCNT

 +3        NEW GMTSD,GMTSDIC,GMTSEXSG,GMTSI,GMTSIEN,GMTSII,GMTSIQ,GMTSJ,GMTSK

 +4        NEW GMTSODIC,GMTSPDIC,GMTSTDIC,GMTSPR,GMTSREC,GMTST,GMTSX,GMTSXTRA

 +5        NEW I,PARIEN,PDATE,PN,PSUB,PTYPE,REASON,SIGNEDBY,STATUS,TSPEC,TYPE,X,Y

 +6        KILL ^TMP("TIU",$JOB)

           DO MAIN^TIULAPI(DFN,TIUTYPE,"ALL",GMTS1,GMTS2,GMTSNDM,1)

 +7        IF '$DATA(^TMP("TIU",$JOB))

               QUIT 

           DO PNOTE^GMTSPN

           QUIT