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

ORVCODATA02.m

Go to the documentation of this file.
  1. ORVCODATA02 ;SPFO/AJB - VISTA CUTOVER ;Feb 11, 2021@09:05:18
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**529**;DEC 17, 1997;Build 17
  1. Q
  1. ; see ORVCO for list of ICRs/DBIAs
  1. DISCL(DFN) ; disclaimer
  1. N DATA,HDR,I S HDR="HDR"_$S(+$G(RMD):1,1:"")
  1. F I=1:1 S DATA=$P($T(@HDR+I),";;",2) Q:DATA="EOM" D
  1. . I DATA["[" D
  1. . . N REP S REP("[DATE]")=$$FMTE^XLFDT($$NOW^XLFDT),REP("[PFAC]")=PFAC S DATA=$$REPLACE^XLFSTR(DATA,.REP)
  1. . . N X S X="",$P(X," ",80-$L(DATA))="*",DATA=DATA_X
  1. . D ADDTXT(DATA)
  1. Q
  1. HDR ; disclaimer information top of document
  1. ;;********************************************************************************
  1. ;;* Disclaimer *
  1. ;;* ========== *
  1. ;;* This EHRM CUTOVER DOCUMENT contains pertinent patient information as of *
  1. ;;* [DATE] from [PFAC] CPRS.
  1. ;;*
  1. ;;* No REMOTE data is included in this document and it should be used for *
  1. ;;* reference purposes only. The Joint Longitudinal Viewer (JLV) should be *
  1. ;;* used to access the complete record of local, remote, DoD, and Cerner data. *
  1. ;;* *
  1. ;;* Most new patient data exists in the new EHRM. Note that this is an *
  1. ;;* Administrative document to assist providers who are seeing patients using *
  1. ;;* the new EHRM. If there are multiple EHRM Cutover Reports, please refer to *
  1. ;;* the document with the most current date/time. *
  1. ;;* *
  1. ;;* For Clinical Reminder information, see the document entitled: *
  1. ;;* EHRM CUTOVER REMINDERS [PFAC]
  1. ;;* *
  1. ;;********************************************************************************
  1. ;;
  1. ;;EOM
  1. HDR1 ; clinical reminder disclaimer top of document
  1. ;;********************************************************************************
  1. ;;* Disclaimer *
  1. ;;* ========== *
  1. ;;* This EHRM CUTOVER DOCUMENT contains the Clinical Reminder data as of *
  1. ;;* [DATE] from [PFAC] CPRS.
  1. ;;* *
  1. ;;* New patient data exists in the new EHRM. Note that this is an *
  1. ;;* Administrative document to assist providers who are seeing patients using *
  1. ;;* the new EHRM to aid in transitioning CPRS Reminders due to the new system's *
  1. ;;* Clinical Recommendations. *
  1. ;;* *
  1. ;;********************************************************************************
  1. ;;
  1. ;;EOM
  1. Q
  1. ADDTXT(DATA) ;
  1. S DOCTXT=DOCTXT+1
  1. S DOCTXT(DOCTXT,0)=DATA
  1. Q
  1. PAST(DFN) ; past outpatient encounters
  1. N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
  1. D ADDTXT("Past Appointments"),ADDTXT("=================")
  1. N DATA,END,GBL,IEN,VDT S END=$$FMADD^XLFDT(DT,-1096) ; go back 3 years
  1. N VAERR,VAROOT,VASD S VAROOT="Data",VASD("F")=END,VASD("T")=DT,VASD("W")=123456789 D SDA^VADPT
  1. N I S I=0 F S I=$O(@VAROOT@(I)) Q:'+I S VDT=$P(@VAROOT@(I,"I"),U) D
  1. . S DATA(9999999-VDT)=VDT_U_$P(@VAROOT@(I,"E"),U,2,3)
  1. S VDT=$$NOW^XLFDT,GBL="^SCE" F S VDT=$O(@GBL@("ADFN",DFN,VDT),-1) Q:'+VDT!(VDT<END) S IEN=0 F S IEN=$O(@GBL@("ADFN",DFN,VDT,IEN)) Q:'+IEN D
  1. . N NODE0 S NODE0=$G(@GBL@(IEN,0)) Q:NODE0=""
  1. . N RDT S RDT=9999999-VDT Q:$D(DATA(RDT))
  1. . Q:$P(NODE0,U,6)'=""
  1. . I $P(NODE0,U,4) N GBL S GBL="^SC" Q:+$G(@GBL@($P(NODE0,U,4),"OOS"))
  1. . N GBL,CSC,LOC S GBL="^DIC(40.7)",CSC=$P(NODE0,U,3),CSC=$P($G(@GBL@(CSC,0)),U),LOC=$P(NODE0,U,4),GBL(1)="^SC",LOC=$P($G(@GBL(1)@(LOC,0)),U)
  1. . S DATA(RDT)=VDT_U_$S(LOC'="":LOC,1:CSC)_U_"Unscheduled"
  1. S VDT=0 F S VDT=$O(DATA(VDT)) Q:'+VDT D
  1. . S DATA=$TR($$FMTE^XLFDT(+DATA(VDT),"5MZ"),"@"," "),DATA=$$SETSTR^VALM1($P(DATA(VDT),U,2),DATA,19,56),DATA=$$SETSTR^VALM1($P(DATA(VDT),U,3),DATA,58,21)
  1. . D ADDTXT(DATA)
  1. I '$D(@VAROOT),'$D(DATA) D ADDTXT("No past appointments found.") D ADDTXT("")
  1. K @VAROOT
  1. S CPUCLK(2)=$$CPUTIME^XLFSHAN
  1. S @INF@(" Duration","Past Visits [CPU]")=+$G(@INF@(" Duration","Past Visits [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
  1. S STOP=$H
  1. S @INF@(" Duration","Past Visits [SECS]")=+$G(@INF@(" Duration","Past Visits [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
  1. Q
  1. RMDRS(DFN) ; coversheet reminders
  1. N CPUCLK,START,STOP S START=$H,CPUCLK(1)=$$CPUTIME^XLFSHAN
  1. N CNT,DILOCKTM,DISYS,GBL,I,LIST,LOC,NODISC,SEPDTO,XMDUN,XMMG,XPARSYS
  1. S GBL="^DPT",GBL(1)="^DIC(42)"
  1. S LOC=$G(@GBL@(DFN,.1)) S:$L(LOC) LOC=+$G(@GBL(1)@(+$O(@GBL(1)@("B",LOC,0)),44)) ; icr #10035
  1. D APPL^ORQQPXRM(.LIST,DFN,LOC) Q:'$D(LIST)
  1. D ADDTXT("Clinical Reminders")
  1. D ADDTXT("==================")
  1. S I=0 F S I=$O(LIST(I)) Q:'+I D
  1. . I $P(LIST(I),U,6)'=1 Q
  1. . N X S X=$$SETSTR^VALM1($P(LIST(I),U,2),"",1,50)
  1. . N Y S Y=$P(LIST(I),U,3),Y=$S(+Y:$$FMTE^XLFDT(Y),Y="DUE NOW":"Due as of "_$$FMTE^XLFDT(DT),1:Y)
  1. . S X=$$SETSTR^VALM1(Y,X,55,$L(Y))
  1. . D ADDTXT(X)
  1. I '$D(LIST) D ADDTXT("No clinical reminders found.")
  1. D ADDTXT("")
  1. S CPUCLK(2)=$$CPUTIME^XLFSHAN
  1. S @INF@(" Duration","Reminders [CPU]")=+$G(@INF@(" Duration","Reminders [CPU]"))+$$ETIMEMS^XLFSHAN(CPUCLK(1),CPUCLK(2))
  1. S STOP=$H
  1. S @INF@(" Duration","Reminders [SECS]")=+$G(@INF@(" Duration","Reminders [SECS]"))+$$HDIFF^XLFDT(STOP,START,2)
  1. Q