Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53361P

DG53361P.m

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