IVM217P ;ALB/KCL/SEK - Post install routine for IVM*2.0*17; 04/29/98
;;2.0;INCOME VERIFICATION MATCH;**17**;21-OCT-94
;
;
EN ; this entry point is used as a driver for post-installation updates.
D SETON
D PTXFR
D RECOMPIL
Q
;
SETON ; Description: Sets the field DCD MESSAGING ACTIVE? to 1 so that
; financial queries will be transmitted to the HEC and income test
; upload messages may be received from HEC. It is assumed that a
; record, ien=1, exists in the IVM SITE PARAMETER file.
;
; Input: None
; Output: None
;
S $P(^IVM(301.9,1,20),"^")=1
Q
;
;
PTXFR ; Update x-refs on Patient (#2) file fields (SEX, DOB, SSN)
N IVMA,IVMFLD,IVMI,IVMZERO
D BMES^XPDUTL(">>> Updating IVM cross-references on PATIENT (#2) file fields")
;
; - for each field, do (update ivm x-ref)
F IVMI=2,3,9 S IVMFLD=".0"_IVMI D
.S IVMA=0 F S IVMA=$O(^DD(2,IVMFLD,1,IVMA)) Q:'IVMA D
..S IVMZERO=$G(^DD(2,IVMFLD,1,IVMA,0))
..Q:$P(IVMZERO,"^",2)'=("IVM0"_IVMI)
..;
..; - new kill logic for DCD financial query
..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"
..;
..S ^DD(2,IVMFLD,1,IVMA,"%D",0)="^^8^8^"_DT_"^"
..S ^DD(2,IVMFLD,1,IVMA,"%D",1,0)="This cross-reference will check the IVM PATIENT file to see if a change"
..S ^DD(2,IVMFLD,1,IVMA,"%D",2,0)="to this field will require transmission to the IVM Center. If it does,"
..S ^DD(2,IVMFLD,1,IVMA,"%D",3,0)="the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and"
..S ^DD(2,IVMFLD,1,IVMA,"%D",4,0)="the nightly background job will transmit the updated information."
..S ^DD(2,IVMFLD,1,IVMA,"%D",5,0)=" "
..S ^DD(2,IVMFLD,1,IVMA,"%D",6,0)="Also, if this field is edited, this cross-reference will check to see if the"
..S ^DD(2,IVMFLD,1,IVMA,"%D",7,0)="patient requires a financial query to be sent to the IVM Center (Data"
..S ^DD(2,IVMFLD,1,IVMA,"%D",8,0)="Collection Division (DCD)."
..S ^DD(2,IVMFLD,1,IVMA,"DT")=DT
..D MES^XPDUTL(" Cross-reference updated for #"_IVMFLD_" ("_$P(^DD(2,IVMFLD,0),"^",1)_") field")
Q
;
;
RECOMPIL ; Re-compiles print and input templates for those fields
; included in the patch.
N FLDLIST,FLD,PTEMP,ETEMP,TEMPLATE,ROUTINE,MAXSIZE,X,Y,DMAX
D LOADFLDS(.FLDLIST) ; Obtain list of fields being sent.
S FLD="" ; For each field...
F S FLD=$O(FLDLIST(FLD)) Q:FLD="" D
. M PTEMP=^DIPT("AF",2,FLD) ; ...note affected print templates...
. M ETEMP=^DIE("AF",2,FLD) ; ...note affected edit templates.
; Determine maximum routine size...
S MAXSIZE=$$ROUSIZE^DILF
; Recompile print templates...
D BMES^XPDUTL(" *****************************")
D BMES^XPDUTL(" * Compiling Print Templates *")
D BMES^XPDUTL(" *****************************")
S TEMPLATE=""
F S TEMPLATE=$O(PTEMP(TEMPLATE)) Q:TEMPLATE="" D
. S ROUTINE=$G(^DIPT(TEMPLATE,"ROU")) ; Note Routine Name
. I ROUTINE="" Q ; Not a compiled template.
. ; Set up bulletproof FileMan call.
. S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
. S $E(X)="" ; Remove initial ^.
. ; This NEW only lasts for one loop iteration...
. N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
. D EN^DIPZ ; Classic FileMan--Trust No One.
; Recompile edit templates...
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" *****************************")
D BMES^XPDUTL(" * Compiling Input Templates *")
D BMES^XPDUTL(" *****************************")
S TEMPLATE=""
F S TEMPLATE=$O(ETEMP(TEMPLATE)) Q:TEMPLATE="" D
. S ROUTINE=$G(^DIE(TEMPLATE,"ROU")) ; Note Routine Name
. I ROUTINE="" Q
. ; Set up bulletproof FileMan call.
. S X=ROUTINE,Y=TEMPLATE,DMAX=MAXSIZE
. S $E(X)="" ; Remove initial ^.
. ; This NEW only lasts for one loop iteration...
. N ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
. D EN^DIEZ ; Classic FileMan--Trust No One.
Q
LOADFLDS(ARR) ; Load field list.
N FNUM,FNAME,LINE,TEXT
F TEXT=1:1 S LINE=$T(FLDS+TEXT) Q:$P(LINE," ")'="" D
. S FNUM=$P(LINE,";",3)
. S FNAME=$P(LINE,";",4)
. S ARR(FNUM)=FNAME
Q
FLDS ; Fields included in this patch.
;;.02;SEX
;;.03;DATE OF BIRTH
;;.09;SOCIAL SECURITY NUMBER
END ;End of field list.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM217P 4179 printed Dec 13, 2024@02:00:54 Page 2
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
+2 ;
+3 ;
EN ; this entry point is used as a driver for post-installation updates.
+1 DO SETON
+2 DO PTXFR
+3 DO RECOMPIL
+4 QUIT
+5 ;
SETON ; Description: Sets the field DCD MESSAGING ACTIVE? to 1 so that
+1 ; financial queries will be transmitted to the HEC and income test
+2 ; upload messages may be received from HEC. It is assumed that a
+3 ; record, ien=1, exists in the IVM SITE PARAMETER file.
+4 ;
+5 ; Input: None
+6 ; Output: None
+7 ;
+8 SET $PIECE(^IVM(301.9,1,20),"^")=1
+9 QUIT
+10 ;
+11 ;
PTXFR ; Update x-refs on Patient (#2) file fields (SEX, DOB, SSN)
+1 NEW IVMA,IVMFLD,IVMI,IVMZERO
+2 DO BMES^XPDUTL(">>> Updating IVM cross-references on PATIENT (#2) file fields")
+3 ;
+4 ; - for each field, do (update ivm x-ref)
+5 FOR IVMI=2,3,9
SET IVMFLD=".0"_IVMI
Begin DoDot:1
+6 SET IVMA=0
FOR
SET IVMA=$ORDER(^DD(2,IVMFLD,1,IVMA))
if 'IVMA
QUIT
Begin DoDot:2
+7 SET IVMZERO=$GET(^DD(2,IVMFLD,1,IVMA,0))
+8 if $PIECE(IVMZERO,"^",2)'=("IVM0"_IVMI)
QUIT
+9 ;
+10 ; - new kill logic for DCD financial query
+11 SET ^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"
+12 ;
+13 SET ^DD(2,IVMFLD,1,IVMA,"%D",0)="^^8^8^"_DT_"^"
+14 SET ^DD(2,IVMFLD,1,IVMA,"%D",1,0)="This cross-reference will check the IVM PATIENT file to see if a change"
+15 SET ^DD(2,IVMFLD,1,IVMA,"%D",2,0)="to this field will require transmission to the IVM Center. If it does,"
+16 SET ^DD(2,IVMFLD,1,IVMA,"%D",3,0)="the IVM PATIENT file entry's TRANSMISSION STATUS will be set to 0 and"
+17 SET ^DD(2,IVMFLD,1,IVMA,"%D",4,0)="the nightly background job will transmit the updated information."
+18 SET ^DD(2,IVMFLD,1,IVMA,"%D",5,0)=" "
+19 SET ^DD(2,IVMFLD,1,IVMA,"%D",6,0)="Also, if this field is edited, this cross-reference will check to see if the"
+20 SET ^DD(2,IVMFLD,1,IVMA,"%D",7,0)="patient requires a financial query to be sent to the IVM Center (Data"
+21 SET ^DD(2,IVMFLD,1,IVMA,"%D",8,0)="Collection Division (DCD)."
+22 SET ^DD(2,IVMFLD,1,IVMA,"DT")=DT
+23 DO MES^XPDUTL(" Cross-reference updated for #"_IVMFLD_" ("_$PIECE(^DD(2,IVMFLD,0),"^",1)_") field")
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;
RECOMPIL ; Re-compiles print and input templates for those fields
+1 ; included in the patch.
+2 NEW FLDLIST,FLD,PTEMP,ETEMP,TEMPLATE,ROUTINE,MAXSIZE,X,Y,DMAX
+3 ; Obtain list of fields being sent.
DO LOADFLDS(.FLDLIST)
+4 ; For each field...
SET FLD=""
+5 FOR
SET FLD=$ORDER(FLDLIST(FLD))
if FLD=""
QUIT
Begin DoDot:1
+6 ; ...note affected print templates...
MERGE PTEMP=^DIPT("AF",2,FLD)
+7 ; ...note affected edit templates.
MERGE ETEMP=^DIE("AF",2,FLD)
End DoDot:1
+8 ; Determine maximum routine size...
+9 SET MAXSIZE=$$ROUSIZE^DILF
+10 ; Recompile print templates...
+11 DO BMES^XPDUTL(" *****************************")
+12 DO BMES^XPDUTL(" * Compiling Print Templates *")
+13 DO BMES^XPDUTL(" *****************************")
+14 SET TEMPLATE=""
+15 FOR
SET TEMPLATE=$ORDER(PTEMP(TEMPLATE))
if TEMPLATE=""
QUIT
Begin DoDot:1
+16 ; Note Routine Name
SET ROUTINE=$GET(^DIPT(TEMPLATE,"ROU"))
+17 ; Not a compiled template.
IF ROUTINE=""
QUIT
+18 ; Set up bulletproof FileMan call.
+19 SET X=ROUTINE
SET Y=TEMPLATE
SET DMAX=MAXSIZE
+20 ; Remove initial ^.
SET $EXTRACT(X)=""
+21 ; This NEW only lasts for one loop iteration...
+22 NEW ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
+23 ; Classic FileMan--Trust No One.
DO EN^DIPZ
End DoDot:1
+24 ; Recompile edit templates...
+25 DO BMES^XPDUTL(" ")
+26 DO BMES^XPDUTL(" *****************************")
+27 DO BMES^XPDUTL(" * Compiling Input Templates *")
+28 DO BMES^XPDUTL(" *****************************")
+29 SET TEMPLATE=""
+30 FOR
SET TEMPLATE=$ORDER(ETEMP(TEMPLATE))
if TEMPLATE=""
QUIT
Begin DoDot:1
+31 ; Note Routine Name
SET ROUTINE=$GET(^DIE(TEMPLATE,"ROU"))
+32 IF ROUTINE=""
QUIT
+33 ; Set up bulletproof FileMan call.
+34 SET X=ROUTINE
SET Y=TEMPLATE
SET DMAX=MAXSIZE
+35 ; Remove initial ^.
SET $EXTRACT(X)=""
+36 ; This NEW only lasts for one loop iteration...
+37 NEW ROUTINE,TEMPLATE,MAXSIZE,PTEMP,ETEMP
+38 ; Classic FileMan--Trust No One.
DO EN^DIEZ
End DoDot:1
+39 QUIT
LOADFLDS(ARR) ; Load field list.
+1 NEW FNUM,FNAME,LINE,TEXT
+2 FOR TEXT=1:1
SET LINE=$TEXT(FLDS+TEXT)
if $PIECE(LINE," ")'=""
QUIT
Begin DoDot:1
+3 SET FNUM=$PIECE(LINE,";",3)
+4 SET FNAME=$PIECE(LINE,";",4)
+5 SET ARR(FNUM)=FNAME
End DoDot:1
+6 QUIT
FLDS ; Fields included in this patch.
+1 ;;.02;SEX
+2 ;;.03;DATE OF BIRTH
+3 ;;.09;SOCIAL SECURITY NUMBER
END ;End of field list.
