- TIUPR222 ; SLC/AJB - TIU Form Letter Update;06Mar07
- ;;1.0;TEXT INTEGRATION UTILITIES;**222**;Jun 20, 1997
- Q
- EN ;
- N TIUQUIT
- I $$PATCH^XPDUTL("TIU*1.0*222") D
- . F NAME="FORM LETTERS","FORM LETTER EXAMPLE" D
- . . I $$CHKTITLE(8925.1,NAME)>0 S TIUQUIT=1
- I +$G(TIUQUIT) W !!,"Titles have already been installed and will not be installed again." Q
- I '$D(ZTQUEUED) X ^%ZOSF("EON") W IOCUON,@IOF
- I $$CHKTITLE(8925.1,"PROGRESS NOTES")<0 G EXIT
- W !!,"Creating the new DOCUMENT CLASS ""FORM LETTERS"" and"
- W !,"and the new TITLE ""FORM LETTER EXAMPLE"" in FILE #8925.1"
- F NAME="FORM LETTERS","FORM LETTER EXAMPLE" D
- . I $$CHKTITLE(8925.1,NAME)>0 D
- . . W !!,"The entry "_NAME_" already exists in "
- . . W !,"File #8925.1 and must be renamed or deleted "
- . . W !,"before installation can continue."
- . . S XPDABORT=1
- I +$G(XPDABORT) G EXIT
- F NAME="FORM LETTERS^DC^PROGRESS NOTES^Form Letters","FORM LETTER EXAMPLE^DOC^FORM LETTERS^Form Letter Example" D
- . D CREATE($P(NAME,U),$P(NAME,U,2))
- . D ATTACH($$CHKTITLE(8925.1,$P(NAME,U)),$$CHKTITLE(8925.1,$P(NAME,U,3)),$P(NAME,U,4))
- . W !!,$P(NAME,U)," created"
- W !!,"Done!"
- EXIT D
- . N DIR,X,Y
- . S DIR(0)="E"
- . W ! D ^DIR
- Q
- CHKTITLE(FILE,NAME) ;
- N DIC,X,Y
- S DIC=FILE,DIC(0)="X"
- S X=NAME
- D ^DIC
- Q +Y
- ATTACH(KID,PARENT,NAME) ;
- N MSG,TIU,TIUIEN
- S TIU(8925.14,"+2,"_PARENT_",",.01)=KID
- S TIU(8925.14,"+2,"_PARENT_",",4)=NAME
- D UPDATE^DIE("","TIU","TIUIEN","MSG")
- Q
- CREATE(NAME,CLASS) ;
- N MSG,TIU,TIUIEN
- S TIU(8925.1,"+1,",.01)=NAME
- S TIU(8925.1,"+1,",.02)=""
- S TIU(8925.1,"+1,",.03)=NAME
- S TIU(8925.1,"+1,",.04)=CLASS
- S TIU(8925.1,"+1,",.05)=""
- S TIU(8925.1,"+1,",.06)=$$LU(8930,"CLINICAL COORDINATOR","X")
- S TIU(8925.1,"+1,",.07)=13
- S TIU(8925.1,"+1,",3.02)=1
- S TIU(8925.1,"+1,",6)="D ENTRY^TIUFLP"
- S TIU(8925.1,"+1,",99)=$H
- D UPDATE^DIE("","TIU","TIUIEN","MSG")
- Q
- MEMBEROF(TITLE,CLASS) ;
- N TIUY S TIUY=0
- S CLASS=+$$CLASS(CLASS) Q:+CLASS'>0 TIUY
- S TIUY=+$$ISA^TIULX(TITLE,CLASS)
- S:TITLE=CLASS TIUY=1
- Q TIUY
- CLASS(CLNAME) ;
- N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
- I +TIUY>0,$S($P($G(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S TIUY=0
- Q TIUY
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
- Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"TIUERR")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPR222 2325 printed Mar 13, 2025@21:48:24 Page 2
- TIUPR222 ; SLC/AJB - TIU Form Letter Update;06Mar07
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**222**;Jun 20, 1997
- +2 QUIT
- EN ;
- +1 NEW TIUQUIT
- +2 IF $$PATCH^XPDUTL("TIU*1.0*222")
- Begin DoDot:1
- +3 FOR NAME="FORM LETTERS","FORM LETTER EXAMPLE"
- Begin DoDot:2
- +4 IF $$CHKTITLE(8925.1,NAME)>0
- SET TIUQUIT=1
- End DoDot:2
- End DoDot:1
- +5 IF +$GET(TIUQUIT)
- WRITE !!,"Titles have already been installed and will not be installed again."
- QUIT
- +6 IF '$DATA(ZTQUEUED)
- XECUTE ^%ZOSF("EON")
- WRITE IOCUON,@IOF
- +7 IF $$CHKTITLE(8925.1,"PROGRESS NOTES")<0
- GOTO EXIT
- +8 WRITE !!,"Creating the new DOCUMENT CLASS ""FORM LETTERS"" and"
- +9 WRITE !,"and the new TITLE ""FORM LETTER EXAMPLE"" in FILE #8925.1"
- +10 FOR NAME="FORM LETTERS","FORM LETTER EXAMPLE"
- Begin DoDot:1
- +11 IF $$CHKTITLE(8925.1,NAME)>0
- Begin DoDot:2
- +12 WRITE !!,"The entry "_NAME_" already exists in "
- +13 WRITE !,"File #8925.1 and must be renamed or deleted "
- +14 WRITE !,"before installation can continue."
- +15 SET XPDABORT=1
- End DoDot:2
- End DoDot:1
- +16 IF +$GET(XPDABORT)
- GOTO EXIT
- +17 FOR NAME="FORM LETTERS^DC^PROGRESS NOTES^Form Letters","FORM LETTER EXAMPLE^DOC^FORM LETTERS^Form Letter Example"
- Begin DoDot:1
- +18 DO CREATE($PIECE(NAME,U),$PIECE(NAME,U,2))
- +19 DO ATTACH($$CHKTITLE(8925.1,$PIECE(NAME,U)),$$CHKTITLE(8925.1,$PIECE(NAME,U,3)),$PIECE(NAME,U,4))
- +20 WRITE !!,$PIECE(NAME,U)," created"
- End DoDot:1
- +21 WRITE !!,"Done!"
- EXIT Begin DoDot:1
- +1 NEW DIR,X,Y
- +2 SET DIR(0)="E"
- +3 WRITE !
- DO ^DIR
- End DoDot:1
- +4 QUIT
- CHKTITLE(FILE,NAME) ;
- +1 NEW DIC,X,Y
- +2 SET DIC=FILE
- SET DIC(0)="X"
- +3 SET X=NAME
- +4 DO ^DIC
- +5 QUIT +Y
- ATTACH(KID,PARENT,NAME) ;
- +1 NEW MSG,TIU,TIUIEN
- +2 SET TIU(8925.14,"+2,"_PARENT_",",.01)=KID
- +3 SET TIU(8925.14,"+2,"_PARENT_",",4)=NAME
- +4 DO UPDATE^DIE("","TIU","TIUIEN","MSG")
- +5 QUIT
- CREATE(NAME,CLASS) ;
- +1 NEW MSG,TIU,TIUIEN
- +2 SET TIU(8925.1,"+1,",.01)=NAME
- +3 SET TIU(8925.1,"+1,",.02)=""
- +4 SET TIU(8925.1,"+1,",.03)=NAME
- +5 SET TIU(8925.1,"+1,",.04)=CLASS
- +6 SET TIU(8925.1,"+1,",.05)=""
- +7 SET TIU(8925.1,"+1,",.06)=$$LU(8930,"CLINICAL COORDINATOR","X")
- +8 SET TIU(8925.1,"+1,",.07)=13
- +9 SET TIU(8925.1,"+1,",3.02)=1
- +10 SET TIU(8925.1,"+1,",6)="D ENTRY^TIUFLP"
- +11 SET TIU(8925.1,"+1,",99)=$HOROLOG
- +12 DO UPDATE^DIE("","TIU","TIUIEN","MSG")
- +13 QUIT
- MEMBEROF(TITLE,CLASS) ;
- +1 NEW TIUY
- SET TIUY=0
- +2 SET CLASS=+$$CLASS(CLASS)
- if +CLASS'>0
- QUIT TIUY
- +3 SET TIUY=+$$ISA^TIULX(TITLE,CLASS)
- +4 if TITLE=CLASS
- SET TIUY=1
- +5 QUIT TIUY
- CLASS(CLNAME) ;
- +1 NEW TIUY
- SET TIUY=+$ORDER(^TIU(8925.1,"B",CLNAME,0))
- +2 IF +TIUY>0
- IF $SELECT($PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$PIECE($GET(^(0)),U,4)="DC":0,1:1)
- SET TIUY=0
- +3 QUIT TIUY
- LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
- +1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"TIUERR")
