TIUDAEN ; SLC/AJB - Disclosure of Adverse Event Note ; August 10, 2005
;;1.0;TEXT INTEGRATION UTILITIES;**191**;Jun 20, 1997
;
Q
EN ;
X ^%ZOSF("EON") W IOCUON,@IOF ; prepares screen during install
N DTOUT,DUOUT,TIU,TIUFPRIV,TIUIEN,TIUMSG,TIUPRNT,TIUTMP S TIUFPRIV=1
I $$LOOKUP(8930,"CLINICAL COORDINATOR","X")<0 W !!,"Installation Error: CLASS OWNER cannot be defined." S XPDABORT=1 G EXIT
I $$LOOKUP(8925.1,"DISCLOSURE OF ADVERSE EVENT NOTE","X")>0 W !!,"Installation Error: DISCLOSURE OF ADVERSE EVENT NOTE already exists." S XPDABORT=1 G EXIT
F D Q:TIUPRNT>0!($D(XPDABORT))
. W ! S TIUPRNT=$$LOOKUP(8925.1,,"AEQ","I $P(^(0),U,4)=""DC""","Select TIU DOCUMENT CLASS name: ")
. I $D(DTOUT) W !!,"Installation Aborted due to TIMEOUT." S XPDABORT=1 Q
. I $D(DUOUT) W !!,"Installation Aborted by USER." S XPDABORT=1 Q
. I TIUPRNT<0 W !!,"Installation Error: Invalid Selection",!
. I W !,"A DOCUMENT CLASS must be entered or '^' to abort." Q
. W ! I '$$READ^TIUU("Y","Is this correct","YES") S TIUPRNT=0
I +$G(TIUPRNT)'>0 G EXIT
S TIU(8925.1,"+1,",.01)="DISCLOSURE OF ADVERSE EVENT NOTE"
S TIU(8925.1,"+1,",.02)=""
S TIU(8925.1,"+1,",.03)="DISCLOSURE OF ADVERSE EVENT NOTE"
S TIU(8925.1,"+1,",.04)="DOC"
S TIU(8925.1,"+1,",.05)=""
S TIU(8925.1,"+1,",.06)=$$LOOKUP(8930,"CLINICAL COORDINATOR")
S TIU(8925.1,"+1,",.07)=13
S TIU(8925.1,"+1,",3.02)=1
S TIU(8925.1,"+1,",99)=$H
W !!,"Creating DISCLOSURE OF ADVERSE EVENT NOTE title..."
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE."
S TIU(8925.14,"+2,"_TIUPRNT_",",.01)=TIUIEN(1)
S TIU(8925.14,"+2,"_TIUPRNT_",",4)="Disclosure of Adverse Event Note"
W !!,"Adding "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent..."
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE.",!
D GETBOIL
S TIUIEN(TIUIEN(1))=TIUIEN(1)
S TIU(8925.1,TIUIEN(1)_",",3)="TIUTMP"
W !,"Adding boilerplate text..."
D UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
I $D(TIUMSG) D S XPDABORT=1 G EXIT
. W !!,"The following error message was returned:",!
. S TIUMSG="" F S TIUMSG=$O(TIUMSG("DIERR",1,"TEXT",TIUMSG)) Q:TIUMSG="" W !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
W "DONE.",!
W !,"*** The DISCLOSURE OF ADVERSE EVENT NOTE ***"
W !,"*** title must be activated before use. ***"
EXIT D
.N DIR,X,Y S DIR(0)="E" W ! D ^DIR
Q
REM ;
N TIUTMP
S TIUTMP=$$LOOKUP(8925.1,"DISCLOSURE OF ADVERSE EVENT NOTE")
I TIUTMP>0 S $P(^TIU(8925.1,TIUTMP,0),U,13)=0
Q
LOOKUP(FILE,NAME,TYPE,SCREEN,PROMPT) ;
; file = file # to perform lookup on
; [name] = for instance lookups - required if type is missing
; [type] = for inquiries to file (eg: "AEQ") - required if name is missing
; [screen] = screen for lookup/inquiries
; [prompt] = replace default prompt
;
N DIC,X,Y S DIC=$G(FILE),DIC("S")=$G(SCREEN),X=$G(NAME)
I $D(TYPE) S DIC(0)=TYPE
I $D(PROMPT) S DIC("A")=PROMPT
D ^DIC
Q +Y
GETBOIL ;
N LINE,LINETXT
F LINE=1:1 S LINETXT=$P($T(BOILTXT+LINE),";;",2) Q:LINETXT="EOM" S TIUTMP(LINE)=LINETXT
Q
BOILTXT ;
;;DATE, TIME, AND PLACE OF DISCUSSION:
;;
;;
;;
;;NAMES OF THOSE PRESENT:
;;
;;
;;
;;DISCUSSION POINTS OF THE ADVERSE EVENT:
;;
;;
;;
;;OFFER OF ASSISTANCE INCLUDING BEREAVEMENT SUPPORT:
;;
;;
;;
;;QUESTIONS ADDRESSED IN THE DISCUSSION:
;;
;;
;;
;;ADVISEMENT OF 1151 CLAIMS PROCESS AND RIGHT TO FILE ADMINISTRATIVE
;;TORT CLAIM:
;;
;;
;;
;;CONTINUED COMMUNICATIONS REGARDING THE ADVERSE EVENT:
;;
;;
;;
;;EOM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUDAEN 3917 printed Apr 09, 2024@21:41:35 Page 2
TIUDAEN ; SLC/AJB - Disclosure of Adverse Event Note ; August 10, 2005
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**191**;Jun 20, 1997
+2 ;
+3 QUIT
EN ;
+1 ; prepares screen during install
XECUTE ^%ZOSF("EON")
WRITE IOCUON,@IOF
+2 NEW DTOUT,DUOUT,TIU,TIUFPRIV,TIUIEN,TIUMSG,TIUPRNT,TIUTMP
SET TIUFPRIV=1
+3 IF $$LOOKUP(8930,"CLINICAL COORDINATOR","X")<0
WRITE !!,"Installation Error: CLASS OWNER cannot be defined."
SET XPDABORT=1
GOTO EXIT
+4 IF $$LOOKUP(8925.1,"DISCLOSURE OF ADVERSE EVENT NOTE","X")>0
WRITE !!,"Installation Error: DISCLOSURE OF ADVERSE EVENT NOTE already exists."
SET XPDABORT=1
GOTO EXIT
+5 FOR
Begin DoDot:1
+6 WRITE !
SET TIUPRNT=$$LOOKUP(8925.1,,"AEQ","I $P(^(0),U,4)=""DC""","Select TIU DOCUMENT CLASS name: ")
+7 IF $DATA(DTOUT)
WRITE !!,"Installation Aborted due to TIMEOUT."
SET XPDABORT=1
QUIT
+8 IF $DATA(DUOUT)
WRITE !!,"Installation Aborted by USER."
SET XPDABORT=1
QUIT
+9 IF TIUPRNT<0
WRITE !!,"Installation Error: Invalid Selection",!
+10 IF $TEST
WRITE !,"A DOCUMENT CLASS must be entered or '^' to abort."
QUIT
+11 WRITE !
IF '$$READ^TIUU("Y","Is this correct","YES")
SET TIUPRNT=0
End DoDot:1
if TIUPRNT>0!($DATA(XPDABORT))
QUIT
+12 IF +$GET(TIUPRNT)'>0
GOTO EXIT
+13 SET TIU(8925.1,"+1,",.01)="DISCLOSURE OF ADVERSE EVENT NOTE"
+14 SET TIU(8925.1,"+1,",.02)=""
+15 SET TIU(8925.1,"+1,",.03)="DISCLOSURE OF ADVERSE EVENT NOTE"
+16 SET TIU(8925.1,"+1,",.04)="DOC"
+17 SET TIU(8925.1,"+1,",.05)=""
+18 SET TIU(8925.1,"+1,",.06)=$$LOOKUP(8930,"CLINICAL COORDINATOR")
+19 SET TIU(8925.1,"+1,",.07)=13
+20 SET TIU(8925.1,"+1,",3.02)=1
+21 SET TIU(8925.1,"+1,",99)=$HOROLOG
+22 WRITE !!,"Creating DISCLOSURE OF ADVERSE EVENT NOTE title..."
+23 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+24 IF $DATA(TIUMSG)
Begin DoDot:1
+25 WRITE !!,"The following error message was returned:",!
+26 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
if TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+27 WRITE "DONE."
+28 SET TIU(8925.14,"+2,"_TIUPRNT_",",.01)=TIUIEN(1)
+29 SET TIU(8925.14,"+2,"_TIUPRNT_",",4)="Disclosure of Adverse Event Note"
+30 WRITE !!,"Adding "_$PIECE(^TIU(8925.1,TIUPRNT,0),U)_" as parent..."
+31 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+32 IF $DATA(TIUMSG)
Begin DoDot:1
+33 WRITE !!,"The following error message was returned:",!
+34 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
if TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+35 WRITE "DONE.",!
+36 DO GETBOIL
+37 SET TIUIEN(TIUIEN(1))=TIUIEN(1)
+38 SET TIU(8925.1,TIUIEN(1)_",",3)="TIUTMP"
+39 WRITE !,"Adding boilerplate text..."
+40 DO UPDATE^DIE("","TIU","TIUIEN","TIUMSG")
+41 IF $DATA(TIUMSG)
Begin DoDot:1
+42 WRITE !!,"The following error message was returned:",!
+43 SET TIUMSG=""
FOR
SET TIUMSG=$ORDER(TIUMSG("DIERR",1,"TEXT",TIUMSG))
if TIUMSG=""
QUIT
WRITE !,TIUMSG("DIERR",1,"TEXT",TIUMSG)
End DoDot:1
SET XPDABORT=1
GOTO EXIT
+44 WRITE "DONE.",!
+45 WRITE !,"*** The DISCLOSURE OF ADVERSE EVENT NOTE ***"
+46 WRITE !,"*** title must be activated before use. ***"
EXIT Begin DoDot:1
+1 NEW DIR,X,Y
SET DIR(0)="E"
WRITE !
DO ^DIR
End DoDot:1
+2 QUIT
REM ;
+1 NEW TIUTMP
+2 SET TIUTMP=$$LOOKUP(8925.1,"DISCLOSURE OF ADVERSE EVENT NOTE")
+3 IF TIUTMP>0
SET $PIECE(^TIU(8925.1,TIUTMP,0),U,13)=0
+4 QUIT
LOOKUP(FILE,NAME,TYPE,SCREEN,PROMPT) ;
+1 ; file = file # to perform lookup on
+2 ; [name] = for instance lookups - required if type is missing
+3 ; [type] = for inquiries to file (eg: "AEQ") - required if name is missing
+4 ; [screen] = screen for lookup/inquiries
+5 ; [prompt] = replace default prompt
+6 ;
+7 NEW DIC,X,Y
SET DIC=$GET(FILE)
SET DIC("S")=$GET(SCREEN)
SET X=$GET(NAME)
+8 IF $DATA(TYPE)
SET DIC(0)=TYPE
+9 IF $DATA(PROMPT)
SET DIC("A")=PROMPT
+10 DO ^DIC
+11 QUIT +Y
GETBOIL ;
+1 NEW LINE,LINETXT
+2 FOR LINE=1:1
SET LINETXT=$PIECE($TEXT(BOILTXT+LINE),";;",2)
if LINETXT="EOM"
QUIT
SET TIUTMP(LINE)=LINETXT
+3 QUIT
BOILTXT ;
+1 ;;DATE, TIME, AND PLACE OF DISCUSSION:
+2 ;;
+3 ;;
+4 ;;
+5 ;;NAMES OF THOSE PRESENT:
+6 ;;
+7 ;;
+8 ;;
+9 ;;DISCUSSION POINTS OF THE ADVERSE EVENT:
+10 ;;
+11 ;;
+12 ;;
+13 ;;OFFER OF ASSISTANCE INCLUDING BEREAVEMENT SUPPORT:
+14 ;;
+15 ;;
+16 ;;
+17 ;;QUESTIONS ADDRESSED IN THE DISCUSSION:
+18 ;;
+19 ;;
+20 ;;
+21 ;;ADVISEMENT OF 1151 CLAIMS PROCESS AND RIGHT TO FILE ADMINISTRATIVE
+22 ;;TORT CLAIM:
+23 ;;
+24 ;;
+25 ;;
+26 ;;CONTINUED COMMUNICATIONS REGARDING THE ADVERSE EVENT:
+27 ;;
+28 ;;
+29 ;;
+30 ;;EOM
+31 QUIT
