- 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 Feb 19, 2025@00:01:19 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