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

DG53440P.m

Go to the documentation of this file. 
  1. DG53440P ;SF/CMC-POST INSTALL FOR DG*5.3*440 ;2/11/02
  1.  ;;5.3;Registration;**440,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. PTXFR ; Create new x-ref in Patient file for SSN .09 field
  1.  D BMES^XPDUTL(">>> Creating new cross reference on PATIENT (#2) file, field SOCIAL SECURITY NUMBER (#.09) --> 'ATSSN'")
  1.  ; Get next ien for ^DD("IX" to place cross-reference
  1.  N IEN,TIEN
  1.  S IEN=0
  1.  I $D(^DD("IX","IX","ATSSN")) D BMES^XPDUTL("X-Reference Already Exists") Q
  1.  F  S IEN=$O(^DD("IX",IEN)) Q:IEN=""  S TIEN=IEN
  1.  I TIEN="" S TIEN=1
  1. CHK I $D(^DD("IX",TIEN)) S TIEN=TIEN+1 G CHK
  1.  S ^DD("IX",TIEN,0)="2^ATSSN^Inactivates Pts that have 5 leading zeros for SSN^MU^^F^IR^I^2^^^^^A"
  1.  S ^DD("IX",TIEN,.1,0)="^^5^5^3020111^"
  1.  S ^DD("IX",TIEN,.1,1,0)="The set of this cross reference is to inactivate a patient with an ICN"
  1.  S ^DD("IX",TIEN,.1,2,0)="(991.01) that have the SSN field value changed to a SSN with 5 leading "
  1.  S ^DD("IX",TIEN,.1,3,0)="zeros. The rules for inactivation will be enforced."
  1.  S ^DD("IX",TIEN,.1,4,0)=""
  1.  S ^DD("IX",TIEN,.1,5,0)="There is not a kill of this cross reference since SSN is a required field."
  1.  S ^DD("IX",TIEN,1)="I $T(SSET^MPIFDEL)'="""",$E(X2(1),1,5)=""00000"" D SSET^MPIFDEL(DA,X2(1))"
  1.  S ^DD("IX",TIEN,2)="Q"
  1.  S ^DD("IX",TIEN,11.1,0)="^.114IA^1^1"
  1.  S ^DD("IX",TIEN,11.1,1,0)="1^F^2^.09^^^F"
  1.  S ^DD("IX",TIEN,11.1,"B",1,1)=""
  1.  S ^DD("IX",TIEN,11.1,"BB",1,1)=""
  1.  S ^DD("IX","IX","ATSSN",TIEN)=""
  1.  S ^DD("IX","BB",2,"ATSSN",TIEN)=""
  1.  S ^DD("IX","B",2,TIEN)=""
  1.  S ^DD("IX","AC",2,TIEN)=""
  1.  S ^DD("IX","F",2,.09,TIEN,1)=""
  1.  ;
  1. COMPILE 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 ;;,.09,
  1.  Q