Routine: DG832P2

DG832P2 ;;ALB/RGB - POST-INSTALL DG*5.3*832 ; 6/24/10 6:42pm

 ;;5.3;Registration;**832**;Aug 13, 1993;Build 9

 ;;Check for updated X-REFS (Fields: .01,.04,.06,.14,.18) used in Input Templates

;;

 ; IA #2796 for use of calls to RGHLLOG in UPDBAI

POST ;Post init

 N DGFLD,DGMFLD,DGOUT,DGFILE

 D TEMPL

TEMPL ;Determine templates on the FILE file to be compiled.

 N GLOBAL,FIELD,NFIELD,FILE,CNT

 D BMES^XPDUTL("Beginning to compile templates on the PATIENT MOVEMENT (#405) file.")

 S NFIELD=".01,.04,.06,.14,.18",FILE=405,FIELD="",CNT=1

 F  S FIELD=$P(NFIELD,",",CNT) Q:FIELD=""  D LOOP(FIELD,FILE) S CNT=CNT+1

 W !!

 S (X,Y)=""

 D BMES^XPDUTL("The following routine namespace compiled:")

 F  S X=$O(CFIELD(X)) Q:X=""  S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"

 D MES^XPDUTL(.PRINT)

 K X,Y,PRINT,CFIELD

LOOP(FIELD,FILE) ;Compile templates.

 N GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX,TYPE

 F GLOBAL="^DIE","^DIPT" D

 . S TYPE="Input" S:GLOBAL="^DIPT" TYPE="Print"

 . I $D(@GLOBAL@("AF",FILE,FIELD)) D

 .. S TEMPLATP=0

 .. F  S TEMPLATP=$O(@GLOBAL@("AF",FILE,FIELD,TEMPLATP)) Q:'TEMPLATP  DO

 ... S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)

 ... I TEMPLATN="" D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!") Q

 ... S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")

 ... I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!") Q

 ... I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q

 ... I $D(CFIELD(X)) Q  ;already compiled

 ... S CFIELD(X)="" ;  remember the template was compiled

 ... S Y=TEMPLATP ;  set up the call for FileMan

 ... S DMAX=$$ROUSIZE^DILF

 ... I GLOBAL="^DIE" D BMES^XPDUTL(" "),BMES^XPDUTL("   Compiling Input Templates") D EN^DIEZ Q

 ... I GLOBAL="^DIPT" D BMES^XPDUTL(" "),BMES^XPDUTL("   Compiling Print Templates") D EN^DIPZ Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG832P2   1897     printed  Feb 19, 2025@00:06:49                                                                                                                                                                                                     Page 2

DG832P2   ;;ALB/RGB - POST-INSTALL DG*5.3*832 ; 6/24/10 6:42pm

 +1       ;;5.3;Registration;**832**;Aug 13, 1993;Build 9

 +2       ;;Check for updated X-REFS (Fields: .01,.04,.06,.14,.18) used in Input Templates

 +3       ;;

 +4       ; IA #2796 for use of calls to RGHLLOG in UPDBAI

POST      ;Post init

 +1        NEW DGFLD,DGMFLD,DGOUT,DGFILE

 +2        DO TEMPL

 +3        QUIT

 +4       ;

TEMPL     ;Determine templates on the FILE file to be compiled.

 +1        NEW GLOBAL,FIELD,NFIELD,FILE,CNT

 +2        DO BMES^XPDUTL("Beginning to compile templates on the PATIENT MOVEMENT (#405) file.")

 +3       ;

 +4        SET NFIELD=".01,.04,.06,.14,.18"

           SET FILE=405

           SET FIELD=""

           SET CNT=1

 +5        FOR

               SET FIELD=$PIECE(NFIELD,",",CNT)

               if FIELD=""

                   QUIT

               DO LOOP(FIELD,FILE)

               SET CNT=CNT+1

 +6        WRITE !!

 +7        SET (X,Y)=""

 +8        DO BMES^XPDUTL("The following routine namespace compiled:")

 +9        FOR

               SET X=$ORDER(CFIELD(X))

               if X=""

                   QUIT

               SET Y=$GET(Y)+1

               SET PRINT(Y)=" "_X_"*"

 +10      ;

 +11       DO MES^XPDUTL(.PRINT)

 +12       KILL X,Y,PRINT,CFIELD

 +13       QUIT

LOOP(FIELD,FILE) ;Compile templates.

 +1        NEW GLOBAL,TEMPLATP,TEMPLATN,X,Y,DMAX,TYPE

 +2        FOR GLOBAL="^DIE","^DIPT"

               Begin DoDot:1

 +3                SET TYPE="Input"

                   if GLOBAL="^DIPT"

                       SET TYPE="Print"

 +4                IF $DATA(@GLOBAL@("AF",FILE,FIELD))

                       Begin DoDot:2

 +5                        SET TEMPLATP=0

 +6                        FOR

                               SET TEMPLATP=$ORDER(@GLOBAL@("AF",FILE,FIELD,TEMPLATP))

                               if 'TEMPLATP

                                   QUIT

                               Begin DoDot:3

 +7                                SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)

 +8                                IF TEMPLATN=""

                                       DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")

                                       QUIT

 +9                                SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")

 +10                               IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)

                                       DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")

                                       QUIT

 +11                               IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)

                                       QUIT

 +12      ;already compiled

                                   IF $DATA(CFIELD(X))

                                       QUIT

 +13      ;  remember the template was compiled

                                   SET CFIELD(X)=""

 +14      ;  set up the call for FileMan

                                   SET Y=TEMPLATP

 +15                               SET DMAX=$$ROUSIZE^DILF

 +16                               IF GLOBAL="^DIE"

                                       DO BMES^XPDUTL(" ")

                                       DO BMES^XPDUTL("   Compiling Input Templates")

                                       DO EN^DIEZ

                                       QUIT

 +17                               IF GLOBAL="^DIPT"

                                       DO BMES^XPDUTL(" ")

                                       DO BMES^XPDUTL("   Compiling Print Templates")

                                       DO EN^DIPZ

                                       QUIT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18       QUIT

 +19      ;

 +20      ;

DG832P2.m