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

IVM217P.m

Go to the documentation of this file. 
  1. IVM217P ;ALB/KCL/SEK - Post install routine for IVM*2.0*17; 04/29/98
  1.  ;;2.0;INCOME VERIFICATION MATCH;**17**;21-OCT-94
  1.  ;
  1.  ;
  1. EN ; this entry point is used as a driver for post-installation updates.
  1.  D SETON
  1.  D PTXFR
  1.  D RECOMPIL
  1.  Q
  1.  ;
  1. SETON ; Description:  Sets the field DCD MESSAGING ACTIVE? to 1 so that
  1.  ; financial queries will be transmitted to the HEC and income test
  1.  ; upload messages may be received from HEC.  It is assumed that a
  1.  ; record, ien=1, exists in the IVM SITE PARAMETER file.
  1.  ;
  1.  ;  Input: None
  1.  ; Output: None
  1.  ;
  1.  S $P(^IVM(301.9,1,20),"^")=1
  1.  Q
  1.  ;
  1.  ;
  1. PTXFR ; Update x-refs on Patient (#2) file fields (SEX, DOB, SSN)
  1.  N IVMA,IVMFLD,IVMI,IVMZERO
  1.  D BMES^XPDUTL(">>> Updating IVM cross-references on PATIENT (#2) file fields")
  1.  ;
  1.  ; - for each field, do (update ivm x-ref)
  1.  F IVMI=2,3,9 S IVMFLD=".0"_IVMI D
  1.  .S IVMA=0 F  S IVMA=$O(^DD(2,IVMFLD,1,IVMA)) Q:'IVMA  D
  1.  ..S IVMZERO=$G(^DD(2,IVMFLD,1,IVMA,0))
  1.  ..Q:$P(IVMZERO,"^",2)'=("IVM0"_IVMI)
  1.  ..;
  1.  ..; - new kill logic for DCD financial query
  1.  ..S ^DD(2,IVMFLD,1,IVMA,2)="S IVMX=X,IVMKILL="_IVMI_",X=""IVMPXFR"" X ^%ZOSF(""TEST"") D:$T DPT^IVMPXFR S X=IVMX K IVMX,IVMKILL"
  1.  ..;
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",0)="^^8^8^"_DT_"^"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",1,0)="This cross-reference will check the IVM PATIENT file to see if a change"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",2,0)="to this field will require transmission to the IVM Center.  If it does,"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",3,0)="the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",4,0)="the nightly background job will transmit the updated information."
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",5,0)=" "
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",6,0)="Also, if this field is edited, this cross-reference will check to see if the"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",7,0)="patient requires a financial query to be sent to the IVM Center (Data"
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"%D",8,0)="Collection Division (DCD)."
  1.  ..S ^DD(2,IVMFLD,1,IVMA,"DT")=DT
  1.  ..D MES^XPDUTL("     Cross-reference updated for #"_IVMFLD_" ("_$P(^DD(2,IVMFLD,0),"^",1)_") field")
  1.  Q
  1.  ;
  1.  ;
  1. RECOMPIL ; Re-compiles print and input templates for those fields
  1.  ; included in the patch.
  1.  N FLDLIST,FLD,PTEMP,ETEMP,TEMPLATE,ROUTINE,MAXSIZE,X,Y,DMAX
  1.  D LOADFLDS(.FLDLIST) ; Obtain list of fields being sent.
  1.  S FLD="" ; For each field...
  1.  F  S FLD=$O(FLDLIST(FLD)) Q:FLD=""  D
  1.  . M PTEMP=^DIPT("AF",2,FLD) ; ...note affected print templates...
  1.  . M ETEMP=^DIE("AF",2,FLD) ; ...note affected edit templates.
  1.  ; Determine maximum routine size...
  1.  S MAXSIZE=$$ROUSIZE^DILF
  1.  ; Recompile print templates...
  1.  D BMES^XPDUTL(" *****************************")
  1.  D BMES^XPDUTL(" * Compiling Print Templates *")
  1.  D BMES^XPDUTL(" *****************************")
  1.  S TEMPLATE=""
  1.  F  S TEMPLATE=$O(PTEMP(TEMPLATE)) Q:TEMPLATE=""  D
  1.  . S ROUTINE=$G(^DIPT(TEMPLATE,"ROU")) ; Note Routine Name
  1.  . I ROUTINE="" Q  ; Not a compiled template.
  1.  . ; Set up bulletproof FileMan call.
  1.  . S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
  1.  . S $E(X)="" ; Remove initial ^.
  1.  . ; This NEW only lasts for one loop iteration...
  1.  . N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
  1.  . D EN^DIPZ ; Classic FileMan--Trust No One.
  1.  ; Recompile edit templates...
  1.  D BMES^XPDUTL("   ")
  1.  D BMES^XPDUTL(" *****************************")
  1.  D BMES^XPDUTL(" * Compiling Input Templates *")
  1.  D BMES^XPDUTL(" *****************************")
  1.  S TEMPLATE=""
  1.  F  S TEMPLATE=$O(ETEMP(TEMPLATE)) Q:TEMPLATE=""  D
  1.  . S ROUTINE=$G(^DIE(TEMPLATE,"ROU")) ; Note Routine Name
  1.  . I ROUTINE="" Q
  1.  . ; Set up bulletproof FileMan call.
  1.  . S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
  1.  . S $E(X)="" ; Remove initial ^.
  1.  . ; This NEW only lasts for one loop iteration...
  1.  . N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
  1.  . D EN^DIEZ ; Classic FileMan--Trust No One.
  1.  Q
  1. LOADFLDS(ARR) ; Load field list.
  1.  N FNUM,FNAME,LINE,TEXT
  1.  F TEXT=1:1 S LINE=$T(FLDS+TEXT) Q:$P(LINE," ")'=""  D
  1.  . S FNUM=$P(LINE,";",3)
  1.  . S FNAME=$P(LINE,";",4)
  1.  . S ARR(FNUM)=FNAME
  1.  Q
  1. FLDS ; Fields included in this patch.
  1.  ;;.02;SEX
  1.  ;;.03;DATE OF BIRTH
  1.  ;;.09;SOCIAL SECURITY NUMBER
  1. END ;End of field list.