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