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 Nov 22, 2024@17:07:17 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
