TIU330P.m

TIU330P ;SPFO/AJB - VistA Cutoff  ;Mar 24, 2021@10:46:20

 ;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51

 ;

 ; $$FIND1^DIC     ICR#2051     MES^XPDUTL     ICR#10141

 ; $$SITE^VASITE   ICR#10112

 Q

PRE ;

 N DC,DOC,SCR,SITE,TIUFPRIV

 S SITE=$$SITE^VASITE,SITE=$P(SITE,U,2),TIUFPRIV=1

 ; check document class entry EHRM CUTOVER

 S SCR="I $P(^(0),U,4)=""DC""" ; screen for the document class

 S DC=$$LU(8925.1,"EHRM CUTOVER","X",SCR) I +DC D MES^XPDUTL("EHRM CUTOVER document class found.")

 ; create new dc if not found

 I '+DC S DC=$$CRDD^TIUCRDD("EHRM CUTOVER","DC","ACTIVE","PROGRESS NOTES") I +DC D

 . D MES^XPDUTL("Installed document class EHRM CUTOVER.")

 ; display error message and quit

 I '+DC D MES^XPDUTL($P(DC,U,2)) Q

 ; check document titles

 S SCR="I $P(^(0),U,4)=""DOC""" ; screen for the document title

 F DOC="EHRM CUTOVER ","EHRM CUTOVER REMINDERS " D

 . ; set document title length to 60 just in case, attempt lookup

 . S DOC=DOC_SITE,DOC=$E(DOC,1,60),DOC("IEN")=$$LU(8925.1,DOC,"X",SCR) I +DOC("IEN") D MES^XPDUTL(DOC_" title found.") Q

 . S DOC("IEN")=$$CRDD^TIUCRDD(DOC,"DOC","ACTIVE","EHRM CUTOVER","CARE MANAGEMENT NOTE") I +DOC("IEN") D MES^XPDUTL("Installed title "_DOC_".") Q

 . I '+DOC("IEN") D MES^XPDUTL($P(DOC("IEN"),U,2))

 Q

LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;

 N DILOCKTM,DISYS

 Q $$FIND1^DIC(FILE,$G(IENS),$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIU330P   1432     printed  Apr 09, 2024@21:46:49                                                                                                                                                                                                     Page 2

TIU330P   ;SPFO/AJB - VistA Cutoff  ;Mar 24, 2021@10:46:20

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**330**;Jun 20, 1997;Build 51

 +2       ;

 +3       ; $$FIND1^DIC     ICR#2051     MES^XPDUTL     ICR#10141

 +4       ; $$SITE^VASITE   ICR#10112

 +5        QUIT 

PRE       ;

 +1        NEW DC,DOC,SCR,SITE,TIUFPRIV

 +2        SET SITE=$$SITE^VASITE

           SET SITE=$PIECE(SITE,U,2)

           SET TIUFPRIV=1

 +3       ; check document class entry EHRM CUTOVER

 +4       ; screen for the document class

           SET SCR="I $P(^(0),U,4)=""DC"""

 +5        SET DC=$$LU(8925.1,"EHRM CUTOVER","X",SCR)

           IF +DC

               DO MES^XPDUTL("EHRM CUTOVER document class found.")

 +6       ; create new dc if not found

 +7        IF '+DC

               SET DC=$$CRDD^TIUCRDD("EHRM CUTOVER","DC","ACTIVE","PROGRESS NOTES")

               IF +DC

                   Begin DoDot:1

 +8                    DO MES^XPDUTL("Installed document class EHRM CUTOVER.")

                   End DoDot:1

 +9       ; display error message and quit

 +10       IF '+DC

               DO MES^XPDUTL($PIECE(DC,U,2))

               QUIT 

 +11      ; check document titles

 +12      ; screen for the document title

           SET SCR="I $P(^(0),U,4)=""DOC"""

 +13       FOR DOC="EHRM CUTOVER ","EHRM CUTOVER REMINDERS "

               Begin DoDot:1

 +14      ; set document title length to 60 just in case, attempt lookup

 +15               SET DOC=DOC_SITE

                   SET DOC=$EXTRACT(DOC,1,60)

                   SET DOC("IEN")=$$LU(8925.1,DOC,"X",SCR)

                   IF +DOC("IEN")

                       DO MES^XPDUTL(DOC_" title found.")

                       QUIT 

 +16               SET DOC("IEN")=$$CRDD^TIUCRDD(DOC,"DOC","ACTIVE","EHRM CUTOVER","CARE MANAGEMENT NOTE")

                   IF +DOC("IEN")

                       DO MES^XPDUTL("Installed title "_DOC_".")

                       QUIT 

 +17               IF '+DOC("IEN")

                       DO MES^XPDUTL($PIECE(DOC("IEN"),U,2))

               End DoDot:1

 +18       QUIT 

LU(FILE,NAME,FLAGS,SCREEN,INDEXES,IENS) ;

 +1        NEW DILOCKTM,DISYS

 +2        QUIT $$FIND1^DIC(FILE,$GET(IENS),$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")