TIUPS265 ; ISD/HGW - Post-Install for 265 ;03/13/12 15:46
;;1.0;TEXT INTEGRATION UTILITIES;**265**;Jun 20, 1997;Build 25
; Post Installation Routine for patch TIU*1.0*265
; Installs Title and maps it to Enterprise Standard Title and Document Class
;
; EXTERNAL REFERENCES
; BMES^XPDUTL 10141
; $$FIND1^DIC
; NOW^%DTC
; UPDATE^DIE 2053
;
MAIN ; Control subroutine
N TIUFPRIV,TIU265X,TIUDNM,TIUSNM,TIUNATL,TIUDC
S TIUFPRIV=1
S TIUDNM="PATIENT RECORD FLAG CATEGORY I - HIGH RISK FOR SUICIDE" ; Name
S TIUSNM="PRF Cat I - Suicide" ; Short Name
S TIUNATL="MENTAL HEALTH PATIENT RECORD FLAG" ; Enterprise Standard Title
S TIUDC="PATIENT RECORD FLAG CAT I" ; Document Class
S TIU265X=$$CREATE(TIUDNM,TIUNATL) ; TIU265X is "Success message" or "Error text"
D BMES^XPDUTL(TIU265X)
S TIU265X=$$INSTALL(TIUDNM,TIUDC,TIUSNM) ; TIU265X is "Success message" or "Error text"
D BMES^XPDUTL(TIU265X)
Q
CREATE(TIUDNM,TIUNATL) ; Create new DDEF entry
N %,TIUERR,TIUFDA,TIUIEN,TIUMSG
S TIUERR=" Title Created: "_TIUDNM
S TIUFDA(8925.1,"?+1,",.01)=TIUDNM ; NAME
S TIUFDA(8925.1,"?+1,",.03)=TIUDNM ; PRINT NAME
S TIUFDA(8925.1,"?+1,",.04)="DOC" ; TYPE: TITLE
S TIUFDA(8925.1,"?+1,",.06)=$$FIND1^DIC(8930,"","X","CLINICAL COORDINATOR","B") ; OWNER
S TIUFDA(8925.1,"?+1,",.07)=11 ; STATUS: ACTIVE
S TIUFDA(8925.1,"?+1,",.13)=1 ; NATIONAL STANDARD: YES
S TIUFDA(8925.1,"?+1,",3.02)=1 ; OK TO DISTRIBUTE: YES
S TIUFDA(8925.1,"?+1,",99)=$H ; TIMESTAMP
S TIUFDA(8925.1,"?+1,",1501)=$$FIND1^DIC(8926.1,"","X",TIUNATL,"B") ; VHA ENTERPRISE STANDARD TITLE
D NOW^%DTC S TIUFDA(8925.1,"?+1,",1502)=% ; MAP ATTEMPTED
S TIUFDA(8925.1,"?+1,",1503)=DUZ ; MAP ATTEMPTED BY
D UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
I $D(TIUMSG) D Q TIUERR
. S TIUERR=" **ERROR** "_$G(TIUMSG("DIERR",1))_" Unable to create Title "_TIUDNM
Q TIUERR
INSTALL(TIUDNM,TIUDC,TIUSNM) ; Install document definition
N TIUERR,TIUFPRIV,TIUTIEN,TIUDIEN,TIUFDA,TIUIEN,TIUMSG
S TIUERR=" Title attached to Document Class "_TIUDC
S TIUFPRIV=1
; Find the IEN of the Title
S TIUTIEN=$$FIND1^DIC(8925.1,"","X",TIUDNM,"B")
I 'TIUTIEN D Q TIUERR
. S TIUERR=" **ERROR** Unable to locate Title "_TIUDNM
; Find the IEN of the Document Class
S TIUDIEN=$$FIND1^DIC(8925.1,"","X",TIUDC,"B")
I 'TIUDIEN D Q TIUERR
. S TIUERR=" **ERROR** Unable to locate Document Class "_TIUDC
; Attach the Title to Document Class
S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",.01)=TIUTIEN ; ITEM
S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",2)="" ; MNEMONIC
S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",3)="" ; SEQUENCE
S TIUFDA(8925.14,"?+2,"_TIUDIEN_",",4)=TIUSNM ; MENU TEXT
D UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
I $D(TIUMSG) D Q TIUERR
. S TIUERR=" **ERROR** Unable to update Document Class "_TIUDC
Q TIUERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS265 2843 printed Oct 16, 2024@18:44:56 Page 2
TIUPS265 ; ISD/HGW - Post-Install for 265 ;03/13/12 15:46
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**265**;Jun 20, 1997;Build 25
+2 ; Post Installation Routine for patch TIU*1.0*265
+3 ; Installs Title and maps it to Enterprise Standard Title and Document Class
+4 ;
+5 ; EXTERNAL REFERENCES
+6 ; BMES^XPDUTL 10141
+7 ; $$FIND1^DIC
+8 ; NOW^%DTC
+9 ; UPDATE^DIE 2053
+10 ;
MAIN ; Control subroutine
+1 NEW TIUFPRIV,TIU265X,TIUDNM,TIUSNM,TIUNATL,TIUDC
+2 SET TIUFPRIV=1
+3 ; Name
SET TIUDNM="PATIENT RECORD FLAG CATEGORY I - HIGH RISK FOR SUICIDE"
+4 ; Short Name
SET TIUSNM="PRF Cat I - Suicide"
+5 ; Enterprise Standard Title
SET TIUNATL="MENTAL HEALTH PATIENT RECORD FLAG"
+6 ; Document Class
SET TIUDC="PATIENT RECORD FLAG CAT I"
+7 ; TIU265X is "Success message" or "Error text"
SET TIU265X=$$CREATE(TIUDNM,TIUNATL)
+8 DO BMES^XPDUTL(TIU265X)
+9 ; TIU265X is "Success message" or "Error text"
SET TIU265X=$$INSTALL(TIUDNM,TIUDC,TIUSNM)
+10 DO BMES^XPDUTL(TIU265X)
+11 QUIT
CREATE(TIUDNM,TIUNATL) ; Create new DDEF entry
+1 NEW %,TIUERR,TIUFDA,TIUIEN,TIUMSG
+2 SET TIUERR=" Title Created: "_TIUDNM
+3 ; NAME
SET TIUFDA(8925.1,"?+1,",.01)=TIUDNM
+4 ; PRINT NAME
SET TIUFDA(8925.1,"?+1,",.03)=TIUDNM
+5 ; TYPE: TITLE
SET TIUFDA(8925.1,"?+1,",.04)="DOC"
+6 ; OWNER
SET TIUFDA(8925.1,"?+1,",.06)=$$FIND1^DIC(8930,"","X","CLINICAL COORDINATOR","B")
+7 ; STATUS: ACTIVE
SET TIUFDA(8925.1,"?+1,",.07)=11
+8 ; NATIONAL STANDARD: YES
SET TIUFDA(8925.1,"?+1,",.13)=1
+9 ; OK TO DISTRIBUTE: YES
SET TIUFDA(8925.1,"?+1,",3.02)=1
+10 ; TIMESTAMP
SET TIUFDA(8925.1,"?+1,",99)=$HOROLOG
+11 ; VHA ENTERPRISE STANDARD TITLE
SET TIUFDA(8925.1,"?+1,",1501)=$$FIND1^DIC(8926.1,"","X",TIUNATL,"B")
+12 ; MAP ATTEMPTED
DO NOW^%DTC
SET TIUFDA(8925.1,"?+1,",1502)=%
+13 ; MAP ATTEMPTED BY
SET TIUFDA(8925.1,"?+1,",1503)=DUZ
+14 DO UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
+15 IF $DATA(TIUMSG)
Begin DoDot:1
+16 SET TIUERR=" **ERROR** "_$GET(TIUMSG("DIERR",1))_" Unable to create Title "_TIUDNM
End DoDot:1
QUIT TIUERR
+17 QUIT TIUERR
INSTALL(TIUDNM,TIUDC,TIUSNM) ; Install document definition
+1 NEW TIUERR,TIUFPRIV,TIUTIEN,TIUDIEN,TIUFDA,TIUIEN,TIUMSG
+2 SET TIUERR=" Title attached to Document Class "_TIUDC
+3 SET TIUFPRIV=1
+4 ; Find the IEN of the Title
+5 SET TIUTIEN=$$FIND1^DIC(8925.1,"","X",TIUDNM,"B")
+6 IF 'TIUTIEN
Begin DoDot:1
+7 SET TIUERR=" **ERROR** Unable to locate Title "_TIUDNM
End DoDot:1
QUIT TIUERR
+8 ; Find the IEN of the Document Class
+9 SET TIUDIEN=$$FIND1^DIC(8925.1,"","X",TIUDC,"B")
+10 IF 'TIUDIEN
Begin DoDot:1
+11 SET TIUERR=" **ERROR** Unable to locate Document Class "_TIUDC
End DoDot:1
QUIT TIUERR
+12 ; Attach the Title to Document Class
+13 ; ITEM
SET TIUFDA(8925.14,"?+2,"_TIUDIEN_",",.01)=TIUTIEN
+14 ; MNEMONIC
SET TIUFDA(8925.14,"?+2,"_TIUDIEN_",",2)=""
+15 ; SEQUENCE
SET TIUFDA(8925.14,"?+2,"_TIUDIEN_",",3)=""
+16 ; MENU TEXT
SET TIUFDA(8925.14,"?+2,"_TIUDIEN_",",4)=TIUSNM
+17 DO UPDATE^DIE("","TIUFDA","TIUIEN","TIUMSG")
+18 IF $DATA(TIUMSG)
Begin DoDot:1
+19 SET TIUERR=" **ERROR** Unable to update Document Class "_TIUDC
End DoDot:1
QUIT TIUERR
+20 QUIT TIUERR
