ORVCODAEMON ;SPFO/AJB - VISTA CUTOVER ;Feb 19, 2021@09:28:36
;;3.0;ORDER ENTRY/RESULTS REPORTING;**529**;Dec 17, 1997;Build 17
Q
; see ORVCO for list of ICRs/DBIAs
SPAWN(THREADS) ; spawn daemon tasks
W @IOF
N IEN,INF,GBL,NEXUS6,THREAD,TOTAL
S ^XTMP("ORVCO",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Data for VistA Cutover event." ; set the main xtmp
S GBL("DPT")="^DPT",GBL=$NA(^XTMP("ORVCO",$J," Patients")) K @GBL ; 'This was something more...'
S INF=$NA(^XTMP("ORVCO",$J,"Info")) K @INF ; 'But he's a lot more afraid of your lying...'
D NEUROTICA(.GBL,INF) ; @Roll the Bones
S THREADS=$S(THREADS>99:99,'+THREADS:1,1:THREADS),@INF@("Threads")=$S(+THREADS:THREADS,1:1) ; set the threads, max threads=99
W " Evaluating patients...",?32,"of ",TOTAL("FM")
; 'You can do a lot in a lifetime if you don't burn out too fast...'
N CNT,DFN S (CNT("Patients"),DFN)=0 F S DFN=$O(@GBL("DPT")@(DFN)) Q:'+DFN D
. S CNT("Actual")=+$G(CNT("Actual"))+1 ; count all actual patients
. D SAY^XGF(0,(31-$L(CNT("Actual"))),CNT("Actual")) ; display # searched
. I +$$BE(DFN) S CNT("Test Patients")=+$G(CNT("Test Patients"))+1 Q ; Tyrell patient?
. I '+$$VISIT(DFN,1096) S CNT("No Visits")=+$G(CNT("No Visits"))+1 Q ; quit if no visit in last 1096 days
. S @GBL@(DFN)=$P($G(@GBL("DPT")@(DFN,0)),U),CNT("Patients")=+$G(CNT("Patients"))+1 ; save patients and count them
I +$P(MODE,U,2) D
. W !!?1,CNT("Patients")," patients ",$S('+CRD:"will be tested for the EHRM Cutover.",1:"may have documents created for the EHRM Cutover.")
. W !!?1,"Patients must have a primary care visit in the last 3 years for reminders"
. W !?1,"documents.",!
W:'+$P(MODE,U,2) !!?1,CNT("Patients")," patients ",$S('+CRD:"will be tested for the EHRM Cutover.",1:"will have documents created for the EHRM Cutover."),!
S EXIT=$$FMR^ORVCO("YAO"," Ready to continue? ","YES","") G:'+EXIT EXIT^ORVCO W " Excellent.",!!," Use the Monitor/Stop Cutover Jobs option to track or stop the progress."
D TOTEM(INF) ; @Test for Echo
D BLOCKS(.THREADS,TOTAL) ; establish the blocks of patients
S THREAD=0,DFN="" F S DFN=$O(IEN(DFN)) Q:DFN="" D
. D TASK(GBL,INF,DFN,IEN(DFN),THREAD,0) ; hard coded 0 for NOT benchmark
. S THREAD=THREAD+1
W ! D PROMPT^ORVCO,CLEAN^XGF
Q
DAEMON(GBL,INF,IEN,BROOD,THREAD,BMARK) ; create background tasks, non-interactive
N $ETRAP,$ESTACK S $ETRAP="D ERR^ORVCO" ; error trap
S ZTREQ="@" ; delete thread from TaskMan if complete ok
N CNT,CRD,DFN,PFAC,RMD,Title,TIME,TOTAL,USR
L +@INF@("Started Threads"):5
S @INF@("Started Threads")=@INF@("Started Threads")+1
L -@INF@("Started Threads"):5
S @INF@(" Daemon",THREAD,"Start Time")=$H ; 'Summer's going fast, nights growing colder...'
; set everything from xtmp
S CRD=@INF@("Mode"),RMD=$P(CRD,U,2),CRD=+CRD,PFAC=@INF@("PFAC"),Title=@INF@("Title"),TOTAL=@INF@("Patients"),USR=@INF@("User"),CNT("No Primary Care")=0
; set count interval based on reminders or summary document
S CNT("Interval")=$FN(TOTAL*$S(+RMD:.01,1:.02),"",0),CNT("Interval")=$S(+CNT("Interval"):CNT("Interval"),1:1)
I +BMARK S TIME=$P($H,",",2)+BMARK ; duration of the benchmark
; 'Where would you rather be?
S CNT("Processed")=0,DFN=IEN F S DFN=$O(@GBL@(DFN)) Q:'+DFN D Q:CNT("Processed")=BROOD I +BMARK Q:$P($H,",",2)'<TIME
. ; count each patient
. S CNT("Processed")=CNT("Processed")+1
. ; check if TaskMan has asked to stop at each interval, quit if yes
. I '(CNT("Processed")#CNT("Interval")),+$$S^%ZTLOAD D Q
. . S (@INF@("Stopped by TaskMan"),@INF@(" Daemon",THREAD,"Stopped"))=1
. . S @INF@(" Daemon",THREAD,"Processed")=CNT("Processed")
. . S CNT("Processed")=BROOD,ZTSTOP=1
. ; if reminders, help the tortoise
. I +RMD,'+$$NEXUS6(DFN,NEXUS6) S CNT("No Primary Care")=+$G(CNT("No Primary Care"))+1,@INF@(" Daemon",THREAD,"Progress")=CNT("Processed") Q
. N PtName S PtName=@GBL@(DFN),PtName=$S(+$L(PtName):PtName,1:"<name unknown>")
. N DOCTXT S DOCTXT=0 D DTXT(.DOCTXT) ; get document text
. ; track progress at the interval or if benchmarking
. I '(CNT("Processed")#CNT("Interval"))!(+BMARK) S @INF@(" Daemon",THREAD,"Progress")=CNT("Processed")
. Q:'+CRD ; quit here test mode
. N DA S DA=$$CREATE^TIUVCO(DFN,+Title,.DOCTXT,USR) I '+DA D Q ; create document
. . S @INF@("Errors")=@INF@("Errors")+1,@INF@("Errors",@INF@("Errors"),+$G(DFN),PtName)=$P(DA,U,2)
. S CNT("Documents")=$G(CNT("Documents"))+1
S:'$D(ZTSTOP) (@INF@(" Daemon",THREAD,"Processed"),@INF@(" Daemon",THREAD,"Progress"))=CNT("Processed")
S @INF@(" Daemon",THREAD,"Documents")=+$G(CNT("Documents"))
S @INF@(" Daemon",THREAD,"No Primary Care")=+$G(CNT("No Primary Care"))
L +@INF@("Stop Count"):5
S @INF@("Stop Count")=$G(@INF@("Stop Count"))+1
L -@INF@("Stop Count"):5
S @INF@(" Daemon",THREAD,"Stop Time")=$H
S @INF@(" Daemon",THREAD,"Elapsed")=$$HDIFF^XLFDT(@INF@(" Daemon",THREAD,"Stop Time"),@INF@(" Daemon",THREAD,"Start Time"),2)
S @INF@(" Daemon",THREAD,"Start Time")=$$HTE^XLFDT(@INF@(" Daemon",THREAD,"Start Time"))
S @INF@(" Daemon",THREAD,"Stop Time")=$$HTE^XLFDT(@INF@(" Daemon",THREAD,"Stop Time"))
I @INF@("Stop Count")=$S(+$G(ZTSTOP):@INF@("Started Threads"),1:@INF@("Threads")) D
. S @INF@("Stop Time")=$H
. S @INF@("Elapsed")=$$HDIFF^XLFDT(@INF@("Stop Time"),@INF@("Start Time"),2)
. S @INF@("Start Time")=$$HTE^XLFDT(@INF@("Start Time"))
. S @INF@("Stop Time")=$$HTE^XLFDT(@INF@("Stop Time"))
. S THREAD=0 F S THREAD=$O(@INF@(" Daemon",THREAD)) Q:'+THREAD D
. . S @INF@("Processed")=+$G(@INF@("Processed"))+$G(@INF@(" Daemon",THREAD,"Processed"))
. . S @INF@("Documents")=+$G(@INF@("Documents"))+$G(@INF@(" Daemon",THREAD,"Documents"))
. . S @INF@("No Primary Care")=+$G(@INF@("No Primary Care"))+$G(@INF@(" Daemon",THREAD,"No Primary Care"))
. S @INF@("Patients")=@INF@("Patients")-$G(@INF@("No Primary Care"))
. ; send completion info and clean up
. S @INF@("Complete")=1
. D:'+$G(BMARK) THEGARDEN^ORVCOEND ; the end
Q
NEUROTICA(GBL,INF) ; 'You just don't get it...what it is, well you're not really sure...'
S @INF@("Calculating")=1
S NEXUS6=$$LU^ORVCO(811.5,"VA-NEXUS CLINIC IN LAST THREE YEARS") ; 'All those moments will be lost in time, like tears in the rain...'
S TOTAL("FM")=$P($G(@GBL("DPT")@(0)),U,4),@INF@("FM Total")=TOTAL("FM") ; patient total reported by FileMan (not always accurate)
Q
TOTEM(INF) ; 'I believe that what I'm feeling changes how the world appears...'
S @INF@("Actual")=$G(CNT("Actual"))
S @INF@("No Visits")=+$G(CNT("No Visits"))
S @INF@("Test Patients")=+$G(CNT("Test Patients"))
S (TOTAL,@INF@("Patients"))=$G(CNT("Patients")) ; total # of patients that meet criteria
S @INF@("Errors")=0,@INF@("Mode")=MODE,@INF@("Start Time")=$H,@INF@("User")=USR
S @INF@("PFAC")=PFAC
S @INF@("Title")=$S(+$P(MODE,U,2):TITLE("Reminders"),1:TITLE("Summary"))
S:$D(CNT("No Primary Care")) @INF@("No Primary Care")=CNT("No Primary Care")
S (@INF@("Started Threads"),@INF@("Calculating"))=0
Q
BLOCKS(THREADS,TOTAL) ;
N BLOCKS,CNT,DFN,THREAD
S BLOCKS=TOTAL\THREADS I '+BLOCKS D ; when you ask for more threads than there are patients to evaluate
. S BLOCKS=1,THREADS=TOTAL,@INF@("Threads")=TOTAL
S (CNT,DFN)=0 F THREAD=0:1:THREADS D
. ; begin patient record loop, quits at block size or if cnt=0 continues through entire global (last block)
. F S DFN=$O(@GBL@(DFN)) Q:'+DFN D I THREAD'=THREADS Q:CNT=$S(+BLOCKS:BLOCKS,1:CNT)
. . S CNT=CNT+1
. S CNT=0 ; reset block count
. I +DFN D Q
. . I THREAD=0 D Q:THREADS=1 ; if starting thread (starts at 0 dfn) at increments, quits if total requested threads=1
. . . S IEN(0)=$S(THREAD=(THREADS-1):0,+BLOCKS:BLOCKS,1:1) ; if last thread, set block size to 0
. . . S THREAD=THREAD+1
. . S IEN(DFN)=$S(THREAD=(THREADS-1):0,+BLOCKS:BLOCKS,1:1)
Q
TASK(GBL,INF,IEN,BROOD,THREAD,BMARK) ; background task, non-interactive
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK S THREAD=THREAD+1
S ZTDESC="daemon "_THREAD_" (non-interactive)" ; description
S ZTDTH=$H,ZTIO="" ; dt/time, device
S (ZTSAVE("NEXUS6"),ZTSAVE("GBL"),ZTSAVE("INF"),ZTSAVE("IEN"),ZTSAVE("BROOD"),ZTSAVE("THREAD"),ZTSAVE("BMARK"))="" ; 'I'll be around, if you don't let me down...'
S ZTRTN="DAEMON^ORVCODAEMON(GBL,INF,IEN,BROOD,THREAD,BMARK)"
D ^%ZTLOAD S @INF@(ZTSK)=""
Q
BE(DFN) ; The Body Electric? aka Am I a Test Patient?
N GBL,NODE S GBL="^DPT" I $D(@GBL@("ATEST",DFN)) Q 1
S NODE=$G(@GBL@(DFN,0)) Q:'+$P(NODE,U,3) 1 ; no DOB
Q:+$P(NODE,U,21) 1 ; test patient indicator
Q:$E($P(NODE,U,9),1,5)="00000" 1
; activate this line after testing Puget Sound
;Q:$E($P(NODE,U),1,2)="ZZ" 1_U_"Last name starts with ZZ"
Q 0
NEXUS6(DFN,TERMIEN) ; N6MAA10816 - Primary care visit in last 3 years?
; input IEN of reminder term: VA-NEXUS CLINIC IN LAST THREE YEARS
I '+TERMIEN Q 1 ; default to yes if term is missing
N FIEVAL,FINDPA,ROU,TERMARR
S ROU="TERM^PXRMLDR(TERMIEN,.TERMARR)" D @ROU
S $P(FINDPA(0),U,14)=1
S ROU="IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.FIEVAL)" D @ROU
Q $G(FIEVAL(1))
VISIT(DFN,X) ; DBIA #2028 returns if patient has visit in X days
N GBL,LASTV S:'+$G(DT) DT=$$DT^XLFDT S GBL="^AUPNVSIT"
S LASTV="",LASTV=$O(@GBL@("C",DFN,LASTV),-1) ; VISIT FILE #9000010
S:+LASTV LASTV=$P($G(@GBL@(LASTV,0),-1),U),LASTV=$$FMDIFF^XLFDT(DT,LASTV) Q:LASTV'>X 1
; check outpatient encounter
S GBL="^SCE(""ADFN"")",LASTV="",LASTV=$O(@GBL@(DFN,LASTV),-1) Q:'+LASTV 0 ; file #409.68
S LASTV=$$FMDIFF^XLFDT(DT,LASTV) Q:LASTV'>X 1
Q 0
DTXT(DOCTXT) ; do section to populate document text
N LINE,SECT F LINE=1:1 S SECT=$P($T(DATA+LINE),";;",2) Q:SECT="" D ; go through all sections of DATA
. I $P($P(SECT,";"),U)="DISCL" D @$P(SECT,";") Q ; always do disclaimer for both types
. I '+RMD,$P($P(SECT,";"),U)'="RMDRS" D @$P(SECT,";") Q ; for regular document(s), don't execute RMDRS section
. I +RMD,$P($P(SECT,";"),U)="RMDRS" D @$P(SECT,";") Q ; for clinical reminders document(s), don't execute non-RMDRS section
Q
DATA ;
;;DISCL^ORVCODATA02(DFN);DISCLAIMER
;;DEMO^ORVCODATA01(DFN);DEMOGRAPHICS
;;SCDIS^ORVCODATA01(DFN);SERVICE CONNECTED/DISABILITY
;;PRF^ORVCODATA01(DFN);PATIENT RECORD FLAGS
;;PROBLST^ORVCODATA01(DFN);PROBLEM LIST
;;ORDERS^ORVCODATA01(DFN);OPEN ORDERS
;;MEDS^ORVCODATA01(DFN);ALL MEDICATIONS
;;ALLERGIES^ORVCODATA01(DFN);ALLERGIES
;;SKIN^ORVCODATA01(DFN);SKIN TEST
;;IMMUINE^ORVCODATA01(DFN);IMMUNIZATIONS
;;IMAG^ORVCODATA01(DFN);IMAGING
;;FUTURE^ORVCODATA01(DFN);FUTURE VISITS
;;PAST^ORVCODATA02(DFN);PAST VISITS
;;RMDRS^ORVCODATA02(DFN);REMINDERS
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORVCODAEMON 10602 printed Sep 23, 2025@20:11:04 Page 2
ORVCODAEMON ;SPFO/AJB - VISTA CUTOVER ;Feb 19, 2021@09:28:36
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**529**;Dec 17, 1997;Build 17
+2 QUIT
+3 ; see ORVCO for list of ICRs/DBIAs
SPAWN(THREADS) ; spawn daemon tasks
+1 WRITE @IOF
+2 NEW IEN,INF,GBL,NEXUS6,THREAD,TOTAL
+3 ; set the main xtmp
SET ^XTMP("ORVCO",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"Data for VistA Cutover event."
+4 ; 'This was something more...'
SET GBL("DPT")="^DPT"
SET GBL=$NAME(^XTMP("ORVCO",$JOB," Patients"))
KILL @GBL
+5 ; 'But he's a lot more afraid of your lying...'
SET INF=$NAME(^XTMP("ORVCO",$JOB,"Info"))
KILL @INF
+6 ; @Roll the Bones
DO NEUROTICA(.GBL,INF)
+7 ; set the threads, max threads=99
SET THREADS=$SELECT(THREADS>99:99,'+THREADS:1,1:THREADS)
SET @INF@("Threads")=$SELECT(+THREADS:THREADS,1:1)
+8 WRITE " Evaluating patients...",?32,"of ",TOTAL("FM")
+9 ; 'You can do a lot in a lifetime if you don't burn out too fast...'
+10 NEW CNT,DFN
SET (CNT("Patients"),DFN)=0
FOR
SET DFN=$ORDER(@GBL("DPT")@(DFN))
if '+DFN
QUIT
Begin DoDot:1
+11 ; count all actual patients
SET CNT("Actual")=+$GET(CNT("Actual"))+1
+12 ; display # searched
DO SAY^XGF(0,(31-$LENGTH(CNT("Actual"))),CNT("Actual"))
+13 ; Tyrell patient?
IF +$$BE(DFN)
SET CNT("Test Patients")=+$GET(CNT("Test Patients"))+1
QUIT
+14 ; quit if no visit in last 1096 days
IF '+$$VISIT(DFN,1096)
SET CNT("No Visits")=+$GET(CNT("No Visits"))+1
QUIT
+15 ; save patients and count them
SET @GBL@(DFN)=$PIECE($GET(@GBL("DPT")@(DFN,0)),U)
SET CNT("Patients")=+$GET(CNT("Patients"))+1
End DoDot:1
+16 IF +$PIECE(MODE,U,2)
Begin DoDot:1
+17 WRITE !!?1,CNT("Patients")," patients ",$SELECT('+CRD:"will be tested for the EHRM Cutover.",1:"may have documents created for the EHRM Cutover.")
+18 WRITE !!?1,"Patients must have a primary care visit in the last 3 years for reminders"
+19 WRITE !?1,"documents.",!
End DoDot:1
+20 if '+$PIECE(MODE,U,2)
WRITE !!?1,CNT("Patients")," patients ",$SELECT('+CRD:"will be tested for the EHRM Cutover.",1:"will have documents created for the EHRM Cutover."),!
+21 SET EXIT=$$FMR^ORVCO("YAO"," Ready to continue? ","YES","")
if '+EXIT
GOTO EXIT^ORVCO
WRITE " Excellent.",!!," Use the Monitor/Stop Cutover Jobs option to track or stop the progress."
+22 ; @Test for Echo
DO TOTEM(INF)
+23 ; establish the blocks of patients
DO BLOCKS(.THREADS,TOTAL)
+24 SET THREAD=0
SET DFN=""
FOR
SET DFN=$ORDER(IEN(DFN))
if DFN=""
QUIT
Begin DoDot:1
+25 ; hard coded 0 for NOT benchmark
DO TASK(GBL,INF,DFN,IEN(DFN),THREAD,0)
+26 SET THREAD=THREAD+1
End DoDot:1
+27 WRITE !
DO PROMPT^ORVCO
DO CLEAN^XGF
+28 QUIT
DAEMON(GBL,INF,IEN,BROOD,THREAD,BMARK) ; create background tasks, non-interactive
+1 ; error trap
NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ORVCO"
+2 ; delete thread from TaskMan if complete ok
SET ZTREQ="@"
+3 NEW CNT,CRD,DFN,PFAC,RMD,Title,TIME,TOTAL,USR
+4 LOCK +@INF@("Started Threads"):5
+5 SET @INF@("Started Threads")=@INF@("Started Threads")+1
+6 LOCK -@INF@("Started Threads"):5
+7 ; 'Summer's going fast, nights growing colder...'
SET @INF@(" Daemon",THREAD,"Start Time")=$HOROLOG
+8 ; set everything from xtmp
+9 SET CRD=@INF@("Mode")
SET RMD=$PIECE(CRD,U,2)
SET CRD=+CRD
SET PFAC=@INF@("PFAC")
SET Title=@INF@("Title")
SET TOTAL=@INF@("Patients")
SET USR=@INF@("User")
SET CNT("No Primary Care")=0
+10 ; set count interval based on reminders or summary document
+11 SET CNT("Interval")=$FNUMBER(TOTAL*$SELECT(+RMD:.01,1:.02),"",0)
SET CNT("Interval")=$SELECT(+CNT("Interval"):CNT("Interval"),1:1)
+12 ; duration of the benchmark
IF +BMARK
SET TIME=$PIECE($HOROLOG,",",2)+BMARK
+13 ; 'Where would you rather be?
+14 SET CNT("Processed")=0
SET DFN=IEN
FOR
SET DFN=$ORDER(@GBL@(DFN))
if '+DFN
QUIT
Begin DoDot:1
+15 ; count each patient
+16 SET CNT("Processed")=CNT("Processed")+1
+17 ; check if TaskMan has asked to stop at each interval, quit if yes
+18 IF '(CNT("Processed")#CNT("Interval"))
IF +$$S^%ZTLOAD
Begin DoDot:2
+19 SET (@INF@("Stopped by TaskMan"),@INF@(" Daemon",THREAD,"Stopped"))=1
+20 SET @INF@(" Daemon",THREAD,"Processed")=CNT("Processed")
+21 SET CNT("Processed")=BROOD
SET ZTSTOP=1
End DoDot:2
QUIT
+22 ; if reminders, help the tortoise
+23 IF +RMD
IF '+$$NEXUS6(DFN,NEXUS6)
SET CNT("No Primary Care")=+$GET(CNT("No Primary Care"))+1
SET @INF@(" Daemon",THREAD,"Progress")=CNT("Processed")
QUIT
+24 NEW PtName
SET PtName=@GBL@(DFN)
SET PtName=$SELECT(+$LENGTH(PtName):PtName,1:"<name unknown>")
+25 ; get document text
NEW DOCTXT
SET DOCTXT=0
DO DTXT(.DOCTXT)
+26 ; track progress at the interval or if benchmarking
+27 IF '(CNT("Processed")#CNT("Interval"))!(+BMARK)
SET @INF@(" Daemon",THREAD,"Progress")=CNT("Processed")
+28 ; quit here test mode
if '+CRD
QUIT
+29 ; create document
NEW DA
SET DA=$$CREATE^TIUVCO(DFN,+Title,.DOCTXT,USR)
IF '+DA
Begin DoDot:2
+30 SET @INF@("Errors")=@INF@("Errors")+1
SET @INF@("Errors",@INF@("Errors"),+$GET(DFN),PtName)=$PIECE(DA,U,2)
End DoDot:2
QUIT
+31 SET CNT("Documents")=$GET(CNT("Documents"))+1
End DoDot:1
if CNT("Processed")=BROOD
QUIT
IF +BMARK
if $PIECE($HOROLOG,",",2)'<TIME
QUIT
+32 if '$DATA(ZTSTOP)
SET (@INF@(" Daemon",THREAD,"Processed"),@INF@(" Daemon",THREAD,"Progress"))=CNT("Processed")
+33 SET @INF@(" Daemon",THREAD,"Documents")=+$GET(CNT("Documents"))
+34 SET @INF@(" Daemon",THREAD,"No Primary Care")=+$GET(CNT("No Primary Care"))
+35 LOCK +@INF@("Stop Count"):5
+36 SET @INF@("Stop Count")=$GET(@INF@("Stop Count"))+1
+37 LOCK -@INF@("Stop Count"):5
+38 SET @INF@(" Daemon",THREAD,"Stop Time")=$HOROLOG
+39 SET @INF@(" Daemon",THREAD,"Elapsed")=$$HDIFF^XLFDT(@INF@(" Daemon",THREAD,"Stop Time"),@INF@(" Daemon",THREAD,"Start Time"),2)
+40 SET @INF@(" Daemon",THREAD,"Start Time")=$$HTE^XLFDT(@INF@(" Daemon",THREAD,"Start Time"))
+41 SET @INF@(" Daemon",THREAD,"Stop Time")=$$HTE^XLFDT(@INF@(" Daemon",THREAD,"Stop Time"))
+42 IF @INF@("Stop Count")=$SELECT(+$GET(ZTSTOP):@INF@("Started Threads"),1:@INF@("Threads"))
Begin DoDot:1
+43 SET @INF@("Stop Time")=$HOROLOG
+44 SET @INF@("Elapsed")=$$HDIFF^XLFDT(@INF@("Stop Time"),@INF@("Start Time"),2)
+45 SET @INF@("Start Time")=$$HTE^XLFDT(@INF@("Start Time"))
+46 SET @INF@("Stop Time")=$$HTE^XLFDT(@INF@("Stop Time"))
+47 SET THREAD=0
FOR
SET THREAD=$ORDER(@INF@(" Daemon",THREAD))
if '+THREAD
QUIT
Begin DoDot:2
+48 SET @INF@("Processed")=+$GET(@INF@("Processed"))+$GET(@INF@(" Daemon",THREAD,"Processed"))
+49 SET @INF@("Documents")=+$GET(@INF@("Documents"))+$GET(@INF@(" Daemon",THREAD,"Documents"))
+50 SET @INF@("No Primary Care")=+$GET(@INF@("No Primary Care"))+$GET(@INF@(" Daemon",THREAD,"No Primary Care"))
End DoDot:2
+51 SET @INF@("Patients")=@INF@("Patients")-$GET(@INF@("No Primary Care"))
+52 ; send completion info and clean up
+53 SET @INF@("Complete")=1
+54 ; the end
if '+$GET(BMARK)
DO THEGARDEN^ORVCOEND
End DoDot:1
+55 QUIT
NEUROTICA(GBL,INF) ; 'You just don't get it...what it is, well you're not really sure...'
+1 SET @INF@("Calculating")=1
+2 ; 'All those moments will be lost in time, like tears in the rain...'
SET NEXUS6=$$LU^ORVCO(811.5,"VA-NEXUS CLINIC IN LAST THREE YEARS")
+3 ; patient total reported by FileMan (not always accurate)
SET TOTAL("FM")=$PIECE($GET(@GBL("DPT")@(0)),U,4)
SET @INF@("FM Total")=TOTAL("FM")
+4 QUIT
TOTEM(INF) ; 'I believe that what I'm feeling changes how the world appears...'
+1 SET @INF@("Actual")=$GET(CNT("Actual"))
+2 SET @INF@("No Visits")=+$GET(CNT("No Visits"))
+3 SET @INF@("Test Patients")=+$GET(CNT("Test Patients"))
+4 ; total # of patients that meet criteria
SET (TOTAL,@INF@("Patients"))=$GET(CNT("Patients"))
+5 SET @INF@("Errors")=0
SET @INF@("Mode")=MODE
SET @INF@("Start Time")=$HOROLOG
SET @INF@("User")=USR
+6 SET @INF@("PFAC")=PFAC
+7 SET @INF@("Title")=$SELECT(+$PIECE(MODE,U,2):TITLE("Reminders"),1:TITLE("Summary"))
+8 if $DATA(CNT("No Primary Care"))
SET @INF@("No Primary Care")=CNT("No Primary Care")
+9 SET (@INF@("Started Threads"),@INF@("Calculating"))=0
+10 QUIT
BLOCKS(THREADS,TOTAL) ;
+1 NEW BLOCKS,CNT,DFN,THREAD
+2 ; when you ask for more threads than there are patients to evaluate
SET BLOCKS=TOTAL\THREADS
IF '+BLOCKS
Begin DoDot:1
+3 SET BLOCKS=1
SET THREADS=TOTAL
SET @INF@("Threads")=TOTAL
End DoDot:1
+4 SET (CNT,DFN)=0
FOR THREAD=0:1:THREADS
Begin DoDot:1
+5 ; begin patient record loop, quits at block size or if cnt=0 continues through entire global (last block)
+6 FOR
SET DFN=$ORDER(@GBL@(DFN))
if '+DFN
QUIT
Begin DoDot:2
+7 SET CNT=CNT+1
End DoDot:2
IF THREAD'=THREADS
if CNT=$SELECT(+BLOCKS
QUIT
+8 ; reset block count
SET CNT=0
+9 IF +DFN
Begin DoDot:2
+10 ; if starting thread (starts at 0 dfn) at increments, quits if total requested threads=1
IF THREAD=0
Begin DoDot:3
+11 ; if last thread, set block size to 0
SET IEN(0)=$SELECT(THREAD=(THREADS-1):0,+BLOCKS:BLOCKS,1:1)
+12 SET THREAD=THREAD+1
End DoDot:3
if THREADS=1
QUIT
+13 SET IEN(DFN)=$SELECT(THREAD=(THREADS-1):0,+BLOCKS:BLOCKS,1:1)
End DoDot:2
QUIT
End DoDot:1
+14 QUIT
TASK(GBL,INF,IEN,BROOD,THREAD,BMARK) ; background task, non-interactive
+1 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
SET THREAD=THREAD+1
+2 ; description
SET ZTDESC="daemon "_THREAD_" (non-interactive)"
+3 ; dt/time, device
SET ZTDTH=$HOROLOG
SET ZTIO=""
+4 ; 'I'll be around, if you don't let me down...'
SET (ZTSAVE("NEXUS6"),ZTSAVE("GBL"),ZTSAVE("INF"),ZTSAVE("IEN"),ZTSAVE("BROOD"),ZTSAVE("THREAD"),ZTSAVE("BMARK"))=""
+5 SET ZTRTN="DAEMON^ORVCODAEMON(GBL,INF,IEN,BROOD,THREAD,BMARK)"
+6 DO ^%ZTLOAD
SET @INF@(ZTSK)=""
+7 QUIT
BE(DFN) ; The Body Electric? aka Am I a Test Patient?
+1 NEW GBL,NODE
SET GBL="^DPT"
IF $DATA(@GBL@("ATEST",DFN))
QUIT 1
+2 ; no DOB
SET NODE=$GET(@GBL@(DFN,0))
if '+$PIECE(NODE,U,3)
QUIT 1
+3 ; test patient indicator
if +$PIECE(NODE,U,21)
QUIT 1
+4 if $EXTRACT($PIECE(NODE,U,9),1,5)="00000"
QUIT 1
+5 ; activate this line after testing Puget Sound
+6 ;Q:$E($P(NODE,U),1,2)="ZZ" 1_U_"Last name starts with ZZ"
+7 QUIT 0
NEXUS6(DFN,TERMIEN) ; N6MAA10816 - Primary care visit in last 3 years?
+1 ; input IEN of reminder term: VA-NEXUS CLINIC IN LAST THREE YEARS
+2 ; default to yes if term is missing
IF '+TERMIEN
QUIT 1
+3 NEW FIEVAL,FINDPA,ROU,TERMARR
+4 SET ROU="TERM^PXRMLDR(TERMIEN,.TERMARR)"
DO @ROU
+5 SET $PIECE(FINDPA(0),U,14)=1
+6 SET ROU="IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.FIEVAL)"
DO @ROU
+7 QUIT $GET(FIEVAL(1))
VISIT(DFN,X) ; DBIA #2028 returns if patient has visit in X days
+1 NEW GBL,LASTV
if '+$GET(DT)
SET DT=$$DT^XLFDT
SET GBL="^AUPNVSIT"
+2 ; VISIT FILE #9000010
SET LASTV=""
SET LASTV=$ORDER(@GBL@("C",DFN,LASTV),-1)
+3 if +LASTV
SET LASTV=$PIECE($GET(@GBL@(LASTV,0),-1),U)
SET LASTV=$$FMDIFF^XLFDT(DT,LASTV)
if LASTV'>X
QUIT 1
+4 ; check outpatient encounter
+5 ; file #409.68
SET GBL="^SCE(""ADFN"")"
SET LASTV=""
SET LASTV=$ORDER(@GBL@(DFN,LASTV),-1)
if '+LASTV
QUIT 0
+6 SET LASTV=$$FMDIFF^XLFDT(DT,LASTV)
if LASTV'>X
QUIT 1
+7 QUIT 0
DTXT(DOCTXT) ; do section to populate document text
+1 ; go through all sections of DATA
NEW LINE,SECT
FOR LINE=1:1
SET SECT=$PIECE($TEXT(DATA+LINE),";;",2)
if SECT=""
QUIT
Begin DoDot:1
+2 ; always do disclaimer for both types
IF $PIECE($PIECE(SECT,";"),U)="DISCL"
DO @$PIECE(SECT,";")
QUIT
+3 ; for regular document(s), don't execute RMDRS section
IF '+RMD
IF $PIECE($PIECE(SECT,";"),U)'="RMDRS"
DO @$PIECE(SECT,";")
QUIT
+4 ; for clinical reminders document(s), don't execute non-RMDRS section
IF +RMD
IF $PIECE($PIECE(SECT,";"),U)="RMDRS"
DO @$PIECE(SECT,";")
QUIT
End DoDot:1
+5 QUIT
DATA ;
+1 ;;DISCL^ORVCODATA02(DFN);DISCLAIMER
+2 ;;DEMO^ORVCODATA01(DFN);DEMOGRAPHICS
+3 ;;SCDIS^ORVCODATA01(DFN);SERVICE CONNECTED/DISABILITY
+4 ;;PRF^ORVCODATA01(DFN);PATIENT RECORD FLAGS
+5 ;;PROBLST^ORVCODATA01(DFN);PROBLEM LIST
+6 ;;ORDERS^ORVCODATA01(DFN);OPEN ORDERS
+7 ;;MEDS^ORVCODATA01(DFN);ALL MEDICATIONS
+8 ;;ALLERGIES^ORVCODATA01(DFN);ALLERGIES
+9 ;;SKIN^ORVCODATA01(DFN);SKIN TEST
+10 ;;IMMUINE^ORVCODATA01(DFN);IMMUNIZATIONS
+11 ;;IMAG^ORVCODATA01(DFN);IMAGING
+12 ;;FUTURE^ORVCODATA01(DFN);FUTURE VISITS
+13 ;;PAST^ORVCODATA02(DFN);PAST VISITS
+14 ;;RMDRS^ORVCODATA02(DFN);REMINDERS
+15 ;;
+16 QUIT
