TIUPI260.m

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

 ;

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      ;