BTIUVFIX ;IHS/MSC/MGH - POSTINIT FOR PATCH 1009 FIX VISITS ;05-Jan-2012 14:48;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1009**;NOV 04, 2004;Build 22
;
;Routine to fix visits created by Vista Imaging (MAG Windows)
;
EN ;EP
NEW BTIUD,BTIUV,BTIU0,DA,DIE,DR,DITC,X,Y
D MES^XPDUTL("Checking for Vista Imaging visits to fix...hold on, this may take a while")
S BTIUD=3060101 ;START ARBITRARILY at 1/1/2006
F S BTIUD=$O(^AUPNVSIT("B",BTIUD)) Q:BTIUD="" D
.S BTIUV=0
.F S BTIUV=$O(^AUPNVSIT("B",BTIUD,BTIUV)) Q:BTIUV'=+BTIUV D
..Q:'$D(^AUPNVSIT(BTIUV,0)) ;bad xref entry
..Q:$P(^AUPNVSIT(BTIUV,0),U,11) ;delete flag set, don't bother
..Q:$$VAL^XBDIQ1(9000010,BTIUV,.24)'="MAG WINDOWS" ;not a vista imaging visit
..;fix .01 by putting on .12 if there is no time.
..S BTIU0=^AUPNVSIT(BTIUV,0)
..S DR=""
..S X=$P(BTIU0,U,1)
..I X'["." S X=X_".12",DR=$S(DR]"":DR_";",1:""),DR=DR_".01////"_X
..;fix .02 by removing the time
..S X=$P(BTIU0,U,2)
..I X["." S X=$P(X,"."),DR=$S(DR]"":DR_";",1:""),DR=DR_".02////"_X
..;FIX .06 if blank
..I $P(BTIU0,U,6)="" S DR=$S(DR]"":DR_";",1:""),DR=DR_".06////"_DUZ(2) ;SET TO DUZ(2) AS I CAN'T THINK OF ANYTHING ELSE TO SET IT TO
..;FIX .13
..S X=$P(BTIU0,U,13)
..I X["." S X=$P(X,"."),DR=$S(DR]"":DR_";",1:""),DR=DR_".13////"_X
..;CALL DIE TO FIX THIS VISIT
..I DR="" G NOTE ;NOTHING TO FIX, MAYBE POST INIT ALREADY RAN ONCE
..S DIE="^AUPNVSIT(",DA=BTIUV,DITC=1 ;SET DITC TO OVERRIDE "UNEDITABLE" .02 FIELD
..D ^DIE
..I $D(Y) D MES^XPDUTL("Update to Visit IEN: "_BTIUV_" failed")
..K DIE,DA,DITC,DR
NOTE ..;NOW TRY TO CREATE A V NOTE
..D CNOTE(BTIUV)
..Q
.Q
Q
;
CNOTE(BTIUV) ;
;find tiu documents in "V" index for this visit and create V Notes
NEW BTIUX,BTIUY,BTIUZ,A,B,G
S BTIUX=0 F S BTIUX=$O(^TIU(8925,"V",BTIUV,BTIUX)) Q:BTIUX'=+BTIUX D
.;lets check to see if V NOTE is already there in case this post init
.;gets run more than once
.S (A,G)=0 F S A=$O(^AUPNVNOT("AD",BTIUV,A)) Q:A'=+A D
..I $P($G(^AUPNVNOT(A,0)),U,1)=BTIUX S G=1 Q ;this document already has a v note on this visit
.Q:G ;DON'T RECREATE V NOTE, IT IS ALREADY THERE
.D VNOTE(BTIUX,BTIUV,$P(^TIU(8925,BTIUX,0),U,2),"ADD")
.Q
Q
VNOTE(NOTE,VISIT,DFN,MODE) ;EP; -- create v note entry
; -- COPIED FROM BTIUPCC
NEW APCDALVR,APCDADFN,APCDAFLG,APCDLOOK
I $$GET1^DIQ(9000010,+VISIT,.05,"I")'=DFN D MES^XPDUTL("Patient mismatch between visit and TIU doc: "_+VISIT_" "_NOTE) Q ;visit and TIU visit pointer mismatch on patient
S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 ("_MODE_")]"
S APCDALVR("APCDPAT")=DFN
S APCDALVR("APCDVSIT")=+VISIT
S APCDALVR("APCDTDOC")="`"_NOTE
S APCDALVR("APCDTCDT")=$$GET1^DIQ(8925,NOTE,1201,"I")
S X=$$GET1^DIQ(8925,NOTE,1202,"I") I X]"" S APCDALVR("APCDTPRV")="`"_X
D EN^APCDALVR ;calling PEP in PCC
I $G(APCDAFLG) D MES^XPDUTL("Error creating V Note for TIU Document: "_NOTE_" error flag: "_APCDAFLG) Q
Q
;
BTIUVFIX ;IHS/MSC/MGH - POSTINIT FOR PATCH 1009 FIX VISITS ;05-Jan-2012 14:48;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1009**;NOV 04, 2004;Build 22
+2 ;
+3 ;Routine to fix visits created by Vista Imaging (MAG Windows)
+4 ;
EN ;EP
+1 NEW BTIUD,BTIUV,BTIU0,DA,DIE,DR,DITC,X,Y
+2 DO MES^XPDUTL("Checking for Vista Imaging visits to fix...hold on, this may take a while")
+3 ;START ARBITRARILY at 1/1/2006
SET BTIUD=3060101
+4 FOR
SET BTIUD=$ORDER(^AUPNVSIT("B",BTIUD))
IF BTIUD=""
QUIT
Begin DoDot:1
+5 SET BTIUV=0
+6 FOR
SET BTIUV=$ORDER(^AUPNVSIT("B",BTIUD,BTIUV))
IF BTIUV'=+BTIUV
QUIT
Begin DoDot:2
+7 ;bad xref entry
IF '$DATA(^AUPNVSIT(BTIUV,0))
QUIT
+8 ;delete flag set, don't bother
IF $PIECE(^AUPNVSIT(BTIUV,0),U,11)
QUIT
+9 ;not a vista imaging visit
IF $$VAL^XBDIQ1(9000010,BTIUV,.24)'="MAG WINDOWS"
QUIT
+10 ;fix .01 by putting on .12 if there is no time.
+11 SET BTIU0=^AUPNVSIT(BTIUV,0)
+12 SET DR=""
+13 SET X=$PIECE(BTIU0,U,1)
+14 IF X'["."
SET X=X_".12"
SET DR=$SELECT(DR]"":DR_";",1:"")
SET DR=DR_".01////"_X
+15 ;fix .02 by removing the time
+16 SET X=$PIECE(BTIU0,U,2)
+17 IF X["."
SET X=$PIECE(X,".")
SET DR=$SELECT(DR]"":DR_";",1:"")
SET DR=DR_".02////"_X
+18 ;FIX .06 if blank
+19 ;SET TO DUZ(2) AS I CAN'T THINK OF ANYTHING ELSE TO SET IT TO
IF $PIECE(BTIU0,U,6)=""
SET DR=$SELECT(DR]"":DR_";",1:"")
SET DR=DR_".06////"_DUZ(2)
+20 ;FIX .13
+21 SET X=$PIECE(BTIU0,U,13)
+22 IF X["."
SET X=$PIECE(X,".")
SET DR=$SELECT(DR]"":DR_";",1:"")
SET DR=DR_".13////"_X
+23 ;CALL DIE TO FIX THIS VISIT
+24 ;NOTHING TO FIX, MAYBE POST INIT ALREADY RAN ONCE
IF DR=""
GOTO NOTE
+25 ;SET DITC TO OVERRIDE "UNEDITABLE" .02 FIELD
SET DIE="^AUPNVSIT("
SET DA=BTIUV
SET DITC=1
+26 DO ^DIE
+27 IF $DATA(Y)
DO MES^XPDUTL("Update to Visit IEN: "_BTIUV_" failed")
+28 KILL DIE,DA,DITC,DR
NOTE ;NOW TRY TO CREATE A V NOTE
+1 DO CNOTE(BTIUV)
+2 QUIT
End DoDot:2
+3 QUIT
End DoDot:1
+4 QUIT
+5 ;
CNOTE(BTIUV) ;
+1 ;find tiu documents in "V" index for this visit and create V Notes
+2 NEW BTIUX,BTIUY,BTIUZ,A,B,G
+3 SET BTIUX=0
FOR
SET BTIUX=$ORDER(^TIU(8925,"V",BTIUV,BTIUX))
IF BTIUX'=+BTIUX
QUIT
Begin DoDot:1
+4 ;lets check to see if V NOTE is already there in case this post init
+5 ;gets run more than once
+6 SET (A,G)=0
FOR
SET A=$ORDER(^AUPNVNOT("AD",BTIUV,A))
IF A'=+A
QUIT
Begin DoDot:2
+7 ;this document already has a v note on this visit
IF $PIECE($GET(^AUPNVNOT(A,0)),U,1)=BTIUX
SET G=1
QUIT
End DoDot:2
+8 ;DON'T RECREATE V NOTE, IT IS ALREADY THERE
IF G
QUIT
+9 DO VNOTE(BTIUX,BTIUV,$PIECE(^TIU(8925,BTIUX,0),U,2),"ADD")
+10 QUIT
End DoDot:1
+11 QUIT
VNOTE(NOTE,VISIT,DFN,MODE) ;EP; -- create v note entry
+1 ; -- COPIED FROM BTIUPCC
+2 NEW APCDALVR,APCDADFN,APCDAFLG,APCDLOOK
+3 ;visit and TIU visit pointer mismatch on patient
IF $$GET1^DIQ(9000010,+VISIT,.05,"I")'=DFN
DO MES^XPDUTL("Patient mismatch between visit and TIU doc: "_+VISIT_" "_NOTE)
QUIT
+4 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.28 ("_MODE_")]"
+5 SET APCDALVR("APCDPAT")=DFN
+6 SET APCDALVR("APCDVSIT")=+VISIT
+7 SET APCDALVR("APCDTDOC")="`"_NOTE
+8 SET APCDALVR("APCDTCDT")=$$GET1^DIQ(8925,NOTE,1201,"I")
+9 SET X=$$GET1^DIQ(8925,NOTE,1202,"I")
IF X]""
SET APCDALVR("APCDTPRV")="`"_X
+10 ;calling PEP in PCC
DO EN^APCDALVR
+11 IF $GET(APCDAFLG)
DO MES^XPDUTL("Error creating V Note for TIU Document: "_NOTE_" error flag: "_APCDAFLG)
QUIT
+12 QUIT
+13 ;
