DG53361P ;SF/CMC POST INSTALL FOR DG*5.3*361 ; 2/12/01
;;5.3;Registration;**361,1015**;Aug 13, 1993;Build 21
;
;
EN ; entry point for Post Init
D PTXFR
D COMPILE
Q
;
PTXFR ; Create new x-ref in Patient file for NAME .01 field
D BMES^XPDUTL(">>> Creating new cross reference on PATIENT (#2) file, field NAME (#.01) -- AMPIZZ")
I $D(^DD("IX","IX","AMPIZZ")) D BMES^XPDUTL("X-Reference Already Exists") Q
; Get next ien for ^DD("IX" to place cross-reference
N DIK,DA,ZZFDA,ZZIEN
S ZZFDA(.11,"+1,",.01)=2
S ZZFDA(.11,"+1,",.02)="AMPIZZ"
D UPDATE^DIE("","ZZFDA","ZZIEN")
S DA=ZZIEN(1)
I $D(DIERR) D BMES^XPDUTL(">>Problem getting Entry IEN in INDEX FILE") K DIERR Q
;
S ^DD("IX",DA,0)="2^AMPIZZ^Inactivate ICN when patient is ZZ'd or deleted^MU^^F^IR^I^2^^^^^A"
S ^DD("IX",DA,.1,0)="^^12^12^3000824^"
S ^DD("IX",DA,.1,1,0)="The set of this cross reference is to inactivate a patient with an ICN"
S ^DD("IX",DA,.1,2,0)="(991.01) that have been ZZ'd. The rules for inactivation will be"
S ^DD("IX",DA,.1,3,0)="enforced."
S ^DD("IX",DA,.1,4,0)=" "
S ^DD("IX",DA,.1,5,0)="The kill of this cross reference is to inactivate a patient with"
S ^DD("IX",DA,.1,6,0)="an ICN (991.01) that has been deleted (@ entered on the.01). "
S ^DD("IX",DA,.1,7,0)=" "
S ^DD("IX",DA,.1,8,0)="The rules for Inactivtion will be enforced. If in either situation, the"
S ^DD("IX",DA,.1,9,0)="rules don't allow for automatically inactivating the ICN, an exception"
S ^DD("IX",DA,.1,10,0)="message will be generated."
S ^DD("IX",DA,.1,11,0)=" "
S ^DD("IX",DA,.1,12,0)="Inactivating an ICN deletes fields 991.01, 991.02, 991.03 and 991.04"
S ^DD("IX",DA,1)="I $T(ZZSET^MPIFDEL)'="""",$E(X2(1),1,2)=""ZZ"" D ZZSET^MPIFDEL(DA,X2(1))"
S ^DD("IX",DA,2)="I $T(ZZKILL^MPIFDEL)'="""",X2(1)="""" D ZZKILL^MPIFDEL(DA,X2(1))"
S ^DD("IX",DA,11.1,0)="^.114IA^1^1"
S ^DD("IX",DA,11.1,1,0)="1^F^2^.01^^^F"
S ^DD("IX",DA,11.1,"B",1,1)=""
S ^DD("IX",DA,11.1,"BB",1,1)=""
S DIK="^DD(""IX""," D IX1^DIK ;eindex the Index file entry.
Q
;
COMPILE ; Compile print and input templates
N GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
;
D BMES^XPDUTL("Beginning to compile templates on the patient file.")
;
S NFIELD=$P($T(AFIELDS),";;",2) ;get the fields that have new xref
;
F GLOBAL="^DIE","^DIPT" DO
.I GLOBAL="^DIE" D BMES^XPDUTL(" Compiling Input Templates")
.I GLOBAL="^DIPT" DO
. . D BMES^XPDUTL(" ")
. . D BMES^XPDUTL(" Compiling Print Templates")
.;
.S FIELD=0
.; go find templates on fields that have added cross-ref
.F S FIELD=$O(@GLOBAL@("AF",2,FIELD)) Q:'FIELD DO
. .;
. .S CFIELD=","_FIELD_","
. .;if we didn't add the cross reference, quit
. .I NFIELD'[CFIELD Q
. .;
. .S TEMPLATP=0
. .F S TEMPLATP=$O(@GLOBAL@("AF",2,FIELD,TEMPLATP)) Q:'TEMPLATP DO
. . . S TEMPLATN=$P($G(@GLOBAL@(TEMPLATP,0)),"^",1)
. . . I TEMPLATN="" DO Q
. . . . D BMES^XPDUTL("Could not compile template "_TEMPLATN_$C(13,10)_"Please review!")
. . . .;
. . . S X=$P($G(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))'=0) DO Q
. . . . D BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$C(13,10)_"Please review!")
. . . I X=""&($D(@GLOBAL@(TEMPLATP,"ROU"))=0) Q
. . . I $D(FIELD(X)) Q ;already compiled
. . .;
. . . S FIELD(X)="" ; remember the template was compiled
. . . S Y=TEMPLATP ; set up the call for fman
. . . S DMAX=$$ROUSIZE^DILF
. . . I GLOBAL="^DIE" D EN^DIEZ Q
. . . I GLOBAL="^DIPT" D EN^DIPZ Q
.;
W !!!
S (X,Y)=""
D BMES^XPDUTL("The following routine namespace was compiled:")
F S X=$O(FIELD(X)) Q:X="" DO
. S Y=$G(Y)+1 S PRINT(Y)=" "_X_"*"
;
D MES^XPDUTL(.PRINT)
K X,Y,DMAX,PRINT
Q
;
;these are the fields that have a new cross-ref
AFIELDS ;;,.01,
Q
DG53361P ;SF/CMC POST INSTALL FOR DG*5.3*361 ; 2/12/01
+1 ;;5.3;Registration;**361,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;
EN ; entry point for Post Init
+1 DO PTXFR
+2 DO COMPILE
+3 QUIT
+4 ;
PTXFR ; Create new x-ref in Patient file for NAME .01 field
+1 DO BMES^XPDUTL(">>> Creating new cross reference on PATIENT (#2) file, field NAME (#.01) -- AMPIZZ")
+2 IF $DATA(^DD("IX","IX","AMPIZZ"))
DO BMES^XPDUTL("X-Reference Already Exists")
QUIT
+3 ; Get next ien for ^DD("IX" to place cross-reference
+4 NEW DIK,DA,ZZFDA,ZZIEN
+5 SET ZZFDA(.11,"+1,",.01)=2
+6 SET ZZFDA(.11,"+1,",.02)="AMPIZZ"
+7 DO UPDATE^DIE("","ZZFDA","ZZIEN")
+8 SET DA=ZZIEN(1)
+9 IF $DATA(DIERR)
DO BMES^XPDUTL(">>Problem getting Entry IEN in INDEX FILE")
KILL DIERR
QUIT
+10 ;
+11 SET ^DD("IX",DA,0)="2^AMPIZZ^Inactivate ICN when patient is ZZ'd or deleted^MU^^F^IR^I^2^^^^^A"
+12 SET ^DD("IX",DA,.1,0)="^^12^12^3000824^"
+13 SET ^DD("IX",DA,.1,1,0)="The set of this cross reference is to inactivate a patient with an ICN"
+14 SET ^DD("IX",DA,.1,2,0)="(991.01) that have been ZZ'd. The rules for inactivation will be"
+15 SET ^DD("IX",DA,.1,3,0)="enforced."
+16 SET ^DD("IX",DA,.1,4,0)=" "
+17 SET ^DD("IX",DA,.1,5,0)="The kill of this cross reference is to inactivate a patient with"
+18 SET ^DD("IX",DA,.1,6,0)="an ICN (991.01) that has been deleted (@ entered on the.01). "
+19 SET ^DD("IX",DA,.1,7,0)=" "
+20 SET ^DD("IX",DA,.1,8,0)="The rules for Inactivtion will be enforced. If in either situation, the"
+21 SET ^DD("IX",DA,.1,9,0)="rules don't allow for automatically inactivating the ICN, an exception"
+22 SET ^DD("IX",DA,.1,10,0)="message will be generated."
+23 SET ^DD("IX",DA,.1,11,0)=" "
+24 SET ^DD("IX",DA,.1,12,0)="Inactivating an ICN deletes fields 991.01, 991.02, 991.03 and 991.04"
+25 SET ^DD("IX",DA,1)="I $T(ZZSET^MPIFDEL)'="""",$E(X2(1),1,2)=""ZZ"" D ZZSET^MPIFDEL(DA,X2(1))"
+26 SET ^DD("IX",DA,2)="I $T(ZZKILL^MPIFDEL)'="""",X2(1)="""" D ZZKILL^MPIFDEL(DA,X2(1))"
+27 SET ^DD("IX",DA,11.1,0)="^.114IA^1^1"
+28 SET ^DD("IX",DA,11.1,1,0)="1^F^2^.01^^^F"
+29 SET ^DD("IX",DA,11.1,"B",1,1)=""
+30 SET ^DD("IX",DA,11.1,"BB",1,1)=""
+31 ;eindex the Index file entry.
SET DIK="^DD(""IX"","
DO IX1^DIK
+32 QUIT
+33 ;
COMPILE ; Compile print and input templates
+1 NEW GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
+2 ;
+3 DO BMES^XPDUTL("Beginning to compile templates on the patient file.")
+4 ;
+5 ;get the fields that have new xref
SET NFIELD=$PIECE($TEXT(AFIELDS),";;",2)
+6 ;
+7 FOR GLOBAL="^DIE","^DIPT"
Begin DoDot:1
+8 IF GLOBAL="^DIE"
DO BMES^XPDUTL(" Compiling Input Templates")
+9 IF GLOBAL="^DIPT"
Begin DoDot:2
+10 DO BMES^XPDUTL(" ")
+11 DO BMES^XPDUTL(" Compiling Print Templates")
End DoDot:2
+12 ;
+13 SET FIELD=0
+14 ; go find templates on fields that have added cross-ref
+15 FOR
SET FIELD=$ORDER(@GLOBAL@("AF",2,FIELD))
IF 'FIELD
QUIT
Begin DoDot:2
+16 ;
+17 SET CFIELD=","_FIELD_","
+18 ;if we didn't add the cross reference, quit
+19 IF NFIELD'[CFIELD
QUIT
+20 ;
+21 SET TEMPLATP=0
+22 FOR
SET TEMPLATP=$ORDER(@GLOBAL@("AF",2,FIELD,TEMPLATP))
IF 'TEMPLATP
QUIT
Begin DoDot:3
+23 SET TEMPLATN=$PIECE($GET(@GLOBAL@(TEMPLATP,0)),"^",1)
+24 IF TEMPLATN=""
Begin DoDot:4
+25 DO BMES^XPDUTL("Could not compile template "_TEMPLATN_$CHAR(13,10)_"Please review!")
+26 ;
End DoDot:4
QUIT
+27 SET X=$PIECE($GET(@GLOBAL@(TEMPLATP,"ROUOLD")),"^")
+28 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))'=0)
Begin DoDot:4
+29 DO BMES^XPDUTL("Could not find routine for template "_TEMPLATN_$CHAR(13,10)_"Please review!")
End DoDot:4
QUIT
+30 IF X=""&($DATA(@GLOBAL@(TEMPLATP,"ROU"))=0)
QUIT
+31 ;already compiled
IF $DATA(FIELD(X))
QUIT
+32 ;
+33 ; remember the template was compiled
SET FIELD(X)=""
+34 ; set up the call for fman
SET Y=TEMPLATP
+35 SET DMAX=$$ROUSIZE^DILF
+36 IF GLOBAL="^DIE"
DO EN^DIEZ
QUIT
+37 IF GLOBAL="^DIPT"
DO EN^DIPZ
QUIT
End DoDot:3
End DoDot:2
+38 ;
End DoDot:1
+39 WRITE !!!
+40 SET (X,Y)=""
+41 DO BMES^XPDUTL("The following routine namespace was compiled:")
+42 FOR
SET X=$ORDER(FIELD(X))
IF X=""
QUIT
Begin DoDot:1
+43 SET Y=$GET(Y)+1
SET PRINT(Y)=" "_X_"*"
End DoDot:1
+44 ;
+45 DO MES^XPDUTL(.PRINT)
+46 KILL X,Y,DMAX,PRINT
+47 QUIT
+48 ;
+49 ;these are the fields that have a new cross-ref
AFIELDS ;;,.01,
+1 QUIT
