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

BTIUVFIX.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;Routine to fix visits created by Vista Imaging (MAG Windows)
  1.  ;
  1. EN ;EP
  1.  NEW BTIUD,BTIUV,BTIU0,DA,DIE,DR,DITC,X,Y
  1.  D MES^XPDUTL("Checking for Vista Imaging visits to fix...hold on, this may take a while")
  1.  S BTIUD=3060101  ;START ARBITRARILY at 1/1/2006
  1.  F  S BTIUD=$O(^AUPNVSIT("B",BTIUD)) Q:BTIUD=""  D
  1.  .S BTIUV=0
  1.  .F  S BTIUV=$O(^AUPNVSIT("B",BTIUD,BTIUV)) Q:BTIUV'=+BTIUV  D
  1.  ..Q:'$D(^AUPNVSIT(BTIUV,0))  ;bad xref entry
  1.  ..Q:$P(^AUPNVSIT(BTIUV,0),U,11)  ;delete flag set, don't bother
  1.  ..Q:$$VAL^XBDIQ1(9000010,BTIUV,.24)'="MAG WINDOWS"  ;not a vista imaging visit
  1.  ..;fix .01 by putting on .12 if there is no time.
  1.  ..S BTIU0=^AUPNVSIT(BTIUV,0)
  1.  ..S DR=""
  1.  ..S X=$P(BTIU0,U,1)
  1.  ..I X'["." S X=X_".12",DR=$S(DR]"":DR_";",1:""),DR=DR_".01////"_X
  1.  ..;fix .02 by removing the time
  1.  ..S X=$P(BTIU0,U,2)
  1.  ..I X["." S X=$P(X,"."),DR=$S(DR]"":DR_";",1:""),DR=DR_".02////"_X
  1.  ..;FIX .06 if blank
  1.  ..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
  1.  ..;FIX .13
  1.  ..S X=$P(BTIU0,U,13)
  1.  ..I X["." S X=$P(X,"."),DR=$S(DR]"":DR_";",1:""),DR=DR_".13////"_X
  1.  ..;CALL DIE TO FIX THIS VISIT
  1.  ..I DR="" G NOTE  ;NOTHING TO FIX, MAYBE POST INIT ALREADY RAN ONCE
  1.  ..S DIE="^AUPNVSIT(",DA=BTIUV,DITC=1   ;SET DITC TO OVERRIDE "UNEDITABLE" .02 FIELD
  1.  ..D ^DIE
  1.  ..I $D(Y) D MES^XPDUTL("Update to Visit IEN: "_BTIUV_" failed")
  1.  ..K DIE,DA,DITC,DR
  1. NOTE ..;NOW TRY TO CREATE A V NOTE
  1.  ..D CNOTE(BTIUV)
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;
  1. CNOTE(BTIUV) ;
  1.  ;find tiu documents in "V" index for this visit and create V Notes
  1.  NEW BTIUX,BTIUY,BTIUZ,A,B,G
  1.  S BTIUX=0 F  S BTIUX=$O(^TIU(8925,"V",BTIUV,BTIUX)) Q:BTIUX'=+BTIUX  D
  1.  .;lets check to see if V NOTE is already there in case this post init
  1.  .;gets run more than once
  1.  .S (A,G)=0 F  S A=$O(^AUPNVNOT("AD",BTIUV,A)) Q:A'=+A  D
  1.  ..I $P($G(^AUPNVNOT(A,0)),U,1)=BTIUX S G=1 Q  ;this document already has a v note on this visit
  1.  .Q:G  ;DON'T RECREATE V NOTE, IT IS ALREADY THERE
  1.  .D VNOTE(BTIUX,BTIUV,$P(^TIU(8925,BTIUX,0),U,2),"ADD")
  1.  .Q
  1.  Q
  1. VNOTE(NOTE,VISIT,DFN,MODE) ;EP; -- create v note entry
  1.  ; -- COPIED FROM BTIUPCC
  1.  NEW APCDALVR,APCDADFN,APCDAFLG,APCDLOOK
  1.  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
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.28 ("_MODE_")]"
  1.  S APCDALVR("APCDPAT")=DFN
  1.  S APCDALVR("APCDVSIT")=+VISIT
  1.  S APCDALVR("APCDTDOC")="`"_NOTE
  1.  S APCDALVR("APCDTCDT")=$$GET1^DIQ(8925,NOTE,1201,"I")
  1.  S X=$$GET1^DIQ(8925,NOTE,1202,"I") I X]"" S APCDALVR("APCDTPRV")="`"_X
  1.  D EN^APCDALVR        ;calling PEP in PCC
  1.  I $G(APCDAFLG) D MES^XPDUTL("Error creating V Note for TIU Document: "_NOTE_" error flag: "_APCDAFLG) Q
  1.  Q
  1.  ;