- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSCW 1544 printed Mar 13, 2025@21:01:48 Page 2
- 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
