IVM20P ;ALB/CPM - IVM V2.0 POST INITIALIZATION ; 23-JUN-94
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;
D ENPAR ; add parameter entry if necessary
D MG ; add IVM TRANSMISSIONS group, if necessary
D MG1 ; add IVM MESSAGES group
D HL7^IVM20P1 ; add/update HL7 parameters
D MTCT ; add new MT Changes Types to #408.42
D IB ; add new IB Action Status to #350.21
D ^IVMONIT ; install protocols
D ^IVM20P2 ; install list templates
D ^IVM20P3 ; update ^XUTL("XQORM" for IB protocols
D SETPRIM ; flag all Means Tests as the primary test
D BULL^IVM20P1 ; alert the IVM Center of the installation
D PARDATE ; set install date in #301.9
;
; Installation has completed - display final messages
;
D NOW^%DTC S IVMEDT=$H
W !!,">>> Initialization Complete at " S Y=% D DT^DIQ
I $D(IVMBDT) D
.S IVMDAY=+IVMEDT-(+IVMBDT)*86400 ;additional seconds of over midnight
.S X=IVMDAY+$P(IVMEDT,",",2)-$P(IVMBDT,",",2)
.W !," Elapse time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
;
W !!,"The installation of Income Verification Match Version 2.0 has completed."
W !!,"Please be sure that the IVM nightly job (option IVM BACKGROUND JOB) is"
W !,"scheduled to run. If it is not, it should be scheduled to run early"
W !,"each morning."
W !!,"Be sure that it is not scheduled twice!!"
;
W !!,"Remember to re-compile the cross reference routines for the INTEGRATED"
W !,"BILLING ACTION (#350) and ANNUAL MEANS TEST (#408.31) files, using DIKZ,"
W !,"on all of your systems."
;
K IVMMIEN,IVMDIEN,IVMBDT,IVMEDT,IVMDAY,X,I
Q
;
;
ENPAR ; Add an entry in the IVM SITE PARAMETER (#301.9) file.
Q:$D(^IVM(301.9,1)) ; entry already exists
W !!,">>> Creating an entry in the IVM SITE PARAMETER (#301.9) file... "
S DIC="^IVM(301.9,",DIC(0)="",X=$P($$SITE^VASITE,"^",3)
K DD,DO D FILE^DICN
K %,DA,DIC,DIE,X,Y
Q
;
MG ; Add mailgroup for IVM transmissions
S X="IVM TRANSMISSIONS"
S DIC="^XMB(3.8,",DIC(0)="L",DLAYGO=3.8
D ^DIC S (DA,IVMMIEN)=+Y I '$P(Y,U,3) G MGQ
W !!,">>> Adding IVM TRANSMISSIONS mailgroup for network transmissions..."
S DIE=DIC,DR="4////PU;5////^S X=DUZ;7////n;3///^S X=""Contains members to receive IVM HL7 transmissions"";12///^S X=""S.HL SERVER@""_$S(IVMPROD:"""",1:""B"")_""IVM.DOMAIN.EXT"";"
D ^DIE
MGQ K DA,DIC,DIE,DLAYGO,X,Y
Q
;
MG1 ; Add mailgroup for IVM Messages
S X="IVM MESSAGES"
S DIC="^XMB(3.8,",DIC(0)="L",DLAYGO=3.8
D ^DIC S (DA,IVMGPTR)=+Y I '$P(Y,U,3) G MG1Q
W !!,">>> Adding IVM MESSAGES mailgroup for sending results of data transmissions..."
S DIE=DIC,DR="4////PU;5////^S X=DUZ;7////n" D ^DIE
S ^XMB(3.8,IVMGPTR,2,0)="^^3^3^"_DT_"^^^"
S ^XMB(3.8,IVMGPTR,2,1,0)="This mail group will receive messages pertaining to erroneous data"
S ^XMB(3.8,IVMGPTR,2,2,0)="transmitted to the IVM Center and for data to be uploaded from the IVM"
S ^XMB(3.8,IVMGPTR,2,3,0)="Center."
;
; - update pointer in file #301.9
S $P(^IVM(301.9,1,0),"^",2)=IVMGPTR
MG1Q K DA,DIC,DIE,DLAYGO,X,Y,IVMGPTR
Q
;
MTCT ; Add entries to the MEANS TEST CHANGES TYPE (#408.42) file.
I $O(^DG(408.42,"B","MEANS TEST UPLOAD",0)),$O(^DG(408.42,"B","UPLOADED MEANS TEST DELETION",0)) Q
W !!,">>> Adding new entries to the MEANS TEST CHANGES TYPE (#408.42) file... "
F IVMX="MEANS TEST UPLOAD","UPLOADED MEANS TEST DELETION" D
.Q:$O(^DG(408.42,"B",IVMX,0))
.S DIC="^DG(408.42,",DIC(0)="",DLAYGO=408.42,X=IVMX K DD,DO D FILE^DICN
K %,DA,DIC,DLAYGO,IVMX,X,Y
Q
;
PARDATE ; Set today's date into the parameter file.
I '$P(^IVM(301.9,1,0),"^",6) S $P(^IVM(301.9,1,0),"^",6)=DT
Q
;
IB ; Add new hold status in file #350.21.
Q:$D(^IBE(350.21,21))
W !!,">>> Adding a new status in the IB ACTION STATUS (#350.21) file... "
S X="HOLD - REVIEW",DIC(0)="",DINUM=21,DLAYGO=350.21,DIC="^IBE(350.21,"
D FILE^DICN S IBN=+Y
I Y<0 W !," Unable to add new status! Please contact your ISC." G IBQ
S ^IBE(350.21,IBN,0)="HOLD - REVIEW^ON HOLD (REVIEW)^REVIEW^0^0^1"
S DA=IBN,DIK="^IBE(350.21," D IX1^DIK
IBQ K X,DIC,DINUM,DLAYGO,DA,DIK
Q
;
SETPRIM ; Set primary and source fields to 1 for all existing means tests.
Q:+$G(^DD(301.5,0,"VR"))'<2
W !!,">>> Initializing new ANNUAL MEANS TEST file (#408.31) fields for",!," existing entries as follows:"
W !," SOURCE OF INCOME TEST (#.23) = VAMC (value = 1)",!," PRIMARY INCOME TEST FOR YEAR? (#2)= YES (value = 1)",!
S DIE="^DGMT(408.31,",DR=".23////1;2////1"
S DGMTI=0 F DGMTC=1:1 S DGMTI=$O(^DGMT(408.31,DGMTI)) Q:'DGMTI S DA=DGMTI D ^DIE W:'(DGMTC#1000) "."
K DA,DR,DIE,DGMTI,DGMTC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM20P 4729 printed Apr 09, 2024@21:01:34 Page 2
IVM20P ;ALB/CPM - IVM V2.0 POST INITIALIZATION ; 23-JUN-94
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;
+3 ; add parameter entry if necessary
DO ENPAR
+4 ; add IVM TRANSMISSIONS group, if necessary
DO MG
+5 ; add IVM MESSAGES group
DO MG1
+6 ; add/update HL7 parameters
DO HL7^IVM20P1
+7 ; add new MT Changes Types to #408.42
DO MTCT
+8 ; add new IB Action Status to #350.21
DO IB
+9 ; install protocols
DO ^IVMONIT
+10 ; install list templates
DO ^IVM20P2
+11 ; update ^XUTL("XQORM" for IB protocols
DO ^IVM20P3
+12 ; flag all Means Tests as the primary test
DO SETPRIM
+13 ; alert the IVM Center of the installation
DO BULL^IVM20P1
+14 ; set install date in #301.9
DO PARDATE
+15 ;
+16 ; Installation has completed - display final messages
+17 ;
+18 DO NOW^%DTC
SET IVMEDT=$HOROLOG
+19 WRITE !!,">>> Initialization Complete at "
SET Y=%
DO DT^DIQ
+20 IF $DATA(IVMBDT)
Begin DoDot:1
+21 ;additional seconds of over midnight
SET IVMDAY=+IVMEDT-(+IVMBDT)*86400
+22 SET X=IVMDAY+$PIECE(IVMEDT,",",2)-$PIECE(IVMBDT,",",2)
+23 WRITE !," Elapse time for initialization was: ",X\3600," Hours, ",X\60-(X\3600*60)," Minutes, ",X#60," Seconds"
End DoDot:1
+24 ;
+25 WRITE !!,"The installation of Income Verification Match Version 2.0 has completed."
+26 WRITE !!,"Please be sure that the IVM nightly job (option IVM BACKGROUND JOB) is"
+27 WRITE !,"scheduled to run. If it is not, it should be scheduled to run early"
+28 WRITE !,"each morning."
+29 WRITE !!,"Be sure that it is not scheduled twice!!"
+30 ;
+31 WRITE !!,"Remember to re-compile the cross reference routines for the INTEGRATED"
+32 WRITE !,"BILLING ACTION (#350) and ANNUAL MEANS TEST (#408.31) files, using DIKZ,"
+33 WRITE !,"on all of your systems."
+34 ;
+35 KILL IVMMIEN,IVMDIEN,IVMBDT,IVMEDT,IVMDAY,X,I
+36 QUIT
+37 ;
+38 ;
ENPAR ; Add an entry in the IVM SITE PARAMETER (#301.9) file.
+1 ; entry already exists
if $DATA(^IVM(301.9,1))
QUIT
+2 WRITE !!,">>> Creating an entry in the IVM SITE PARAMETER (#301.9) file... "
+3 SET DIC="^IVM(301.9,"
SET DIC(0)=""
SET X=$PIECE($$SITE^VASITE,"^",3)
+4 KILL DD,DO
DO FILE^DICN
+5 KILL %,DA,DIC,DIE,X,Y
+6 QUIT
+7 ;
MG ; Add mailgroup for IVM transmissions
+1 SET X="IVM TRANSMISSIONS"
+2 SET DIC="^XMB(3.8,"
SET DIC(0)="L"
SET DLAYGO=3.8
+3 DO ^DIC
SET (DA,IVMMIEN)=+Y
IF '$PIECE(Y,U,3)
GOTO MGQ
+4 WRITE !!,">>> Adding IVM TRANSMISSIONS mailgroup for network transmissions..."
+5 SET DIE=DIC
SET DR="4////PU;5////^S X=DUZ;7////n;3///^S X=""Contains members to receive IVM HL7 transmissions"";12///^S X=""S.HL SERVER@""_$S(IVMPROD:"""",1:""B"")_""IVM.DOMAIN.EXT"";"
+6 DO ^DIE
MGQ KILL DA,DIC,DIE,DLAYGO,X,Y
+1 QUIT
+2 ;
MG1 ; Add mailgroup for IVM Messages
+1 SET X="IVM MESSAGES"
+2 SET DIC="^XMB(3.8,"
SET DIC(0)="L"
SET DLAYGO=3.8
+3 DO ^DIC
SET (DA,IVMGPTR)=+Y
IF '$PIECE(Y,U,3)
GOTO MG1Q
+4 WRITE !!,">>> Adding IVM MESSAGES mailgroup for sending results of data transmissions..."
+5 SET DIE=DIC
SET DR="4////PU;5////^S X=DUZ;7////n"
DO ^DIE
+6 SET ^XMB(3.8,IVMGPTR,2,0)="^^3^3^"_DT_"^^^"
+7 SET ^XMB(3.8,IVMGPTR,2,1,0)="This mail group will receive messages pertaining to erroneous data"
+8 SET ^XMB(3.8,IVMGPTR,2,2,0)="transmitted to the IVM Center and for data to be uploaded from the IVM"
+9 SET ^XMB(3.8,IVMGPTR,2,3,0)="Center."
+10 ;
+11 ; - update pointer in file #301.9
+12 SET $PIECE(^IVM(301.9,1,0),"^",2)=IVMGPTR
MG1Q KILL DA,DIC,DIE,DLAYGO,X,Y,IVMGPTR
+1 QUIT
+2 ;
MTCT ; Add entries to the MEANS TEST CHANGES TYPE (#408.42) file.
+1 IF $ORDER(^DG(408.42,"B","MEANS TEST UPLOAD",0))
IF $ORDER(^DG(408.42,"B","UPLOADED MEANS TEST DELETION",0))
QUIT
+2 WRITE !!,">>> Adding new entries to the MEANS TEST CHANGES TYPE (#408.42) file... "
+3 FOR IVMX="MEANS TEST UPLOAD","UPLOADED MEANS TEST DELETION"
Begin DoDot:1
+4 if $ORDER(^DG(408.42,"B",IVMX,0))
QUIT
+5 SET DIC="^DG(408.42,"
SET DIC(0)=""
SET DLAYGO=408.42
SET X=IVMX
KILL DD,DO
DO FILE^DICN
End DoDot:1
+6 KILL %,DA,DIC,DLAYGO,IVMX,X,Y
+7 QUIT
+8 ;
PARDATE ; Set today's date into the parameter file.
+1 IF '$PIECE(^IVM(301.9,1,0),"^",6)
SET $PIECE(^IVM(301.9,1,0),"^",6)=DT
+2 QUIT
+3 ;
IB ; Add new hold status in file #350.21.
+1 if $DATA(^IBE(350.21,21))
QUIT
+2 WRITE !!,">>> Adding a new status in the IB ACTION STATUS (#350.21) file... "
+3 SET X="HOLD - REVIEW"
SET DIC(0)=""
SET DINUM=21
SET DLAYGO=350.21
SET DIC="^IBE(350.21,"
+4 DO FILE^DICN
SET IBN=+Y
+5 IF Y<0
WRITE !," Unable to add new status! Please contact your ISC."
GOTO IBQ
+6 SET ^IBE(350.21,IBN,0)="HOLD - REVIEW^ON HOLD (REVIEW)^REVIEW^0^0^1"
+7 SET DA=IBN
SET DIK="^IBE(350.21,"
DO IX1^DIK
IBQ KILL X,DIC,DINUM,DLAYGO,DA,DIK
+1 QUIT
+2 ;
SETPRIM ; Set primary and source fields to 1 for all existing means tests.
+1 if +$GET(^DD(301.5,0,"VR"))'<2
QUIT
+2 WRITE !!,">>> Initializing new ANNUAL MEANS TEST file (#408.31) fields for",!," existing entries as follows:"
+3 WRITE !," SOURCE OF INCOME TEST (#.23) = VAMC (value = 1)",!," PRIMARY INCOME TEST FOR YEAR? (#2)= YES (value = 1)",!
+4 SET DIE="^DGMT(408.31,"
SET DR=".23////1;2////1"
+5 SET DGMTI=0
FOR DGMTC=1:1
SET DGMTI=$ORDER(^DGMT(408.31,DGMTI))
if 'DGMTI
QUIT
SET DA=DGMTI
DO ^DIE
if '(DGMTC#1000)
WRITE "."
+6 KILL DA,DR,DIE,DGMTI,DGMTC
+7 QUIT
