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

DG477PST.m

Go to the documentation of this file. 
  1. DG477PST ;BIR/DRI-DG*5.3*477 PATCH POST INSTALL ROUTINE ;9/11/02
  1.  ;;5.3;Registration;**477,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;Reference to TRIG^DICR supported by IA #3405
  1.  ;
  1. POST ;Post-init functions
  1.  D POST1,POST2
  1.  Q
  1.  ;
  1. POST1 ;recompile input templates and update triggered fields
  1.  ;Recompile input templates
  1.  D COMPILE
  1.  ;Update triggered fields
  1.  D TRIG
  1.  Q
  1.  ;
  1. COMPILE N GLOBAL,FIELD,CFIELD,NFIELD,TEMPLATP,TEMPLATN
  1.  D BMES^XPDUTL("Beginning to compile templates on the PATIENT (#2) 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.  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 ;;,.313,
  1.  Q
  1.  ;
  1. TRIG ;Update trigger definitions
  1.  N DGFLD
  1.  D BMES^XPDUTL("Updating trigger field definitions...")
  1.  F DGFLD=.092,.093 S DGFLD(2,DGFLD)=""
  1.  D T1(.DGFLD)
  1.  Q
  1.  ;
  1. T1(DGFLD) ;Check/update triggering field definitions
  1.  ;Input: DGFLD=array of fields to update
  1.  N DGOUT,DGFILE
  1.  D TRIG^DICR(.DGFLD,.DGOUT)
  1.  S DGFILE=0 F  S DGFILE=$O(DGOUT(DGFILE)) Q:'DGFILE  D
  1.  .S DGFLD=0 F  S DGFLD=$O(DGOUT(DGFILE,DGFLD)) Q:'DGFLD  D
  1.  ..D MES^XPDUTL("         Field #"_DGFLD_" of file #"_DGFILE_" updated.")
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. POST2 ;translate marital status from 'n' to 'never married'
  1.  ;caused by dg*5.3*474 initially installed 10/31/2002
  1.  NEW FIELD,FILE,GLO,IEN,MSCNT,PDR,VAL
  1.  D BMES^XPDUTL(" Translating MARITAL STATUS from 'N' to 'NEVER MARRIED' in the")
  1.  D MES^XPDUTL(" PATIENT DATA ELEMENTS (#391.99) file for PATIENT DATA REVIEWS.")
  1.  S GLO="^DGCN(391.98,""EVT"",3021030)",FILE=2,FIELD=.05,MSCNT=0
  1.  F  S GLO=$Q(@GLO) Q:$QS(GLO,2)'="EVT"  S PDR=$QS(GLO,4) I PDR S IEN=$O(^DGCN(391.99,"AKY",PDR,FILE,FIELD,"")) I IEN Q  ;find first possible affected pdr
  1.  I $G(IEN) S IEN=IEN-1 F  S IEN=$O(^DGCN(391.99,"ASRT",FILE,FIELD,IEN)) Q:'IEN  S VAL=$G(^DGCN(391.99,IEN,"VAL")) I VAL="N" S MSCNT=MSCNT+1 D
  1.  . D UPD(IEN,50,"NEVER MARRIED"),UPD(IEN,.06,"@") ;loop through subsequent marital status elements and update if necessary
  1.  D BMES^XPDUTL(" "_MSCNT_" MARITAL STATUS entries were translated.")
  1.  Q
  1.  ;
  1. UPD(DA,FLD,VAL) ;update value
  1.  L +^DGCN(391.99,DA,0):10 I '$T D BMES^XPDUTL("Unable to lock entry "_DA_" in the PATIENT DATA ELEMENT (#391.99) file.") Q
  1.  S DIE="^DGCN(391.99,"
  1.  S DR=FLD_"///^S X=VAL"
  1.  D ^DIE K DIE,DR
  1.  L -^DGCN(391.99,DA,0)
  1.  Q