TIUPI260 ;SLC/WAT High Risk Mental Health;11/30/11 15:43 ;12/08/11 12:02
;;1.0;TEXT INTEGRATION UTILITIES;**260**;Jun 20, 1997;Build 37
;
;EXTERNAL CALLS
;B/MES^XPDUTL 10141
;UPDATE^DIE 2053
;^DIC 10006
;^DIK 10013
;
Q
EN ;
N TIUFPRIV S TIUFPRIV=1
;
D DELOBJ
;
N NAME,METHOD,PNAME,HSIEN
;
S NAME="MH MISSED APPOINTMENTS 10D"
S PNAME="MISSED MH APPOINTMENTS (10 DAYS)"
S METHOD="S X=$$MSTAPPT^TIULO1(DFN,""^TMP(""""TIU APPT"""",$J)"")"
I $$MKOBJ(NAME,METHOD)<0 D
.D BMES^XPDUTL("Installation Error: Creation of TIU Object "_NAME_" failed.")
Q
;
CHKTITLE(FILE,NAME) ;
N DIC,X,Y
S DIC=FILE,DIC(0)="X"
S X=NAME
D ^DIC
S:+Y'>0 Y=""
Q $P(Y,"^")
;
MKOBJ(NAME,METHOD) ;
N FDA,FDAIEN,MSG
S FDA(8925.1,"+1,",.01)=NAME
S FDA(8925.1,"+1,",.03)=PNAME
S FDA(8925.1,"+1,",.04)="O"
S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
S FDA(8925.1,"+1,",.07)=11
S FDA(8925.1,"+1,",9)=METHOD
S FDA(8925.1,"+1,",99)=$H
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D Q -1
. D AWRITE("MSG")
D BMES^XPDUTL("Creation of TIU Object "_NAME_" successful...") H 1
Q 1
DELOBJ ;
N DA,DIK,X,Y
S DIK="^TIU(8925.1,"
S DA=$O(^TIU(8925.1,"B","MH MISSED APPOINTMENTS 10D",""))
I DA>0 D ^DIK
Q
AWRITE(REF) ;Write all the descendants of the array reference.
;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
N DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,TIUTEXT
I REF="" Q
S LN=0
S PROOT=$P(REF,")",1)
;Build the root so we can tell when we are done.
S TEMP=$NA(@REF)
S ROOT=$P(TEMP,")",1)
S REF=$Q(@REF)
I REF'[ROOT Q
S DONE=0
F Q:(REF="")!(DONE) D
. S START=$F(REF,ROOT)
. S LEN=$L(REF)
. S IND=$E(REF,START,LEN)
. S LN=LN+1,TIUTEXT(LN)=PROOT_IND_"="_@REF
. S REF=$Q(@REF)
. I REF'[ROOT S DONE=1
D MES^XPDUTL(.TIUTEXT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPI260 1876 printed Dec 13, 2024@02:43:10 Page 2
TIUPI260 ;SLC/WAT High Risk Mental Health;11/30/11 15:43 ;12/08/11 12:02
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**260**;Jun 20, 1997;Build 37
+2 ;
+3 ;EXTERNAL CALLS
+4 ;B/MES^XPDUTL 10141
+5 ;UPDATE^DIE 2053
+6 ;^DIC 10006
+7 ;^DIK 10013
+8 ;
+9 QUIT
EN ;
+1 NEW TIUFPRIV
SET TIUFPRIV=1
+2 ;
+3 DO DELOBJ
+4 ;
+5 NEW NAME,METHOD,PNAME,HSIEN
+6 ;
+7 SET NAME="MH MISSED APPOINTMENTS 10D"
+8 SET PNAME="MISSED MH APPOINTMENTS (10 DAYS)"
+9 SET METHOD="S X=$$MSTAPPT^TIULO1(DFN,""^TMP(""""TIU APPT"""",$J)"")"
+10 IF $$MKOBJ(NAME,METHOD)<0
Begin DoDot:1
+11 DO BMES^XPDUTL("Installation Error: Creation of TIU Object "_NAME_" failed.")
End DoDot:1
+12 QUIT
+13 ;
CHKTITLE(FILE,NAME) ;
+1 NEW DIC,X,Y
+2 SET DIC=FILE
SET DIC(0)="X"
+3 SET X=NAME
+4 DO ^DIC
+5 if +Y'>0
SET Y=""
+6 QUIT $PIECE(Y,"^")
+7 ;
MKOBJ(NAME,METHOD) ;
+1 NEW FDA,FDAIEN,MSG
+2 SET FDA(8925.1,"+1,",.01)=NAME
+3 SET FDA(8925.1,"+1,",.03)=PNAME
+4 SET FDA(8925.1,"+1,",.04)="O"
+5 SET FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
+6 SET FDA(8925.1,"+1,",.07)=11
+7 SET FDA(8925.1,"+1,",9)=METHOD
+8 SET FDA(8925.1,"+1,",99)=$HOROLOG
+9 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+10 IF $DATA(MSG)
Begin DoDot:1
+11 DO AWRITE("MSG")
End DoDot:1
QUIT -1
+12 DO BMES^XPDUTL("Creation of TIU Object "_NAME_" successful...")
HANG 1
+13 QUIT 1
DELOBJ ;
+1 NEW DA,DIK,X,Y
+2 SET DIK="^TIU(8925.1,"
+3 SET DA=$ORDER(^TIU(8925.1,"B","MH MISSED APPOINTMENTS 10D",""))
+4 IF DA>0
DO ^DIK
+5 QUIT
AWRITE(REF) ;Write all the descendants of the array reference.
+1 ;REF is the starting array reference, for example A or ^TMP("PXRM",$J).
+2 NEW DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP,TIUTEXT
+3 IF REF=""
QUIT
+4 SET LN=0
+5 SET PROOT=$PIECE(REF,")",1)
+6 ;Build the root so we can tell when we are done.
+7 SET TEMP=$NAME(@REF)
+8 SET ROOT=$PIECE(TEMP,")",1)
+9 SET REF=$QUERY(@REF)
+10 IF REF'[ROOT
QUIT
+11 SET DONE=0
+12 FOR
if (REF="")!(DONE)
QUIT
Begin DoDot:1
+13 SET START=$FIND(REF,ROOT)
+14 SET LEN=$LENGTH(REF)
+15 SET IND=$EXTRACT(REF,START,LEN)
+16 SET LN=LN+1
SET TIUTEXT(LN)=PROOT_IND_"="_@REF
+17 SET REF=$QUERY(@REF)
+18 IF REF'[ROOT
SET DONE=1
End DoDot:1
+19 DO MES^XPDUTL(.TIUTEXT)
+20 QUIT
+21 ;
