source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGVCCMR1.m@ 1720

Last change on this file since 1720 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1RGVCCMR1 ;GAI/TMG-CMOR ACTIVITY SCORE GENERATOR (PART 1) ;01/15/98
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**2,19**;30 Apr 99
3 ;Reference to ^DPT("ACMORS" and ^DPT(0 supported by IA #2070
4 ;
5EN ; this routine contains entry points to start/restart the batch cmor
6 ; score initialization, flag a running
7 ; initialization to stop, calculate and file an activity score for an
8 ; individual patient, and display the status of the cmor initialization
9START ; entry point to start or restart the cmor activity score initialization
10 N RGY
11 S U="^"
12 S NODE=$G(^RGSITE(991.8,1,"CMOR"))
13 I '(+$P(NODE,U)) D G QUIT
14 .W !!,"This is the initial run of the CMOR patient activity score generator."
15 .S RUNTYPE="I",RGDFN=0 D TASK
16 S STATUS=$P(NODE,U,7)
17 I STATUS="R" D I RUN G QUIT
18 .S RUN=0
19 .S ZTSK=+$P(NODE,U,9)
20 .I 'ZTSK D INT Q
21 .D STAT^%ZTLOAD
22 .I ZTSK(1)=0!(ZTSK(1)=3)!(ZTSK(1)=4) D INT Q
23 .I ZTSK(1)=1 W !!,"CMOR Patient Activity Score queued task #",ZTSK,!,"is waiting to run. Do not start another job at this time." S RUN=1 Q
24 .I ZTSK(1)=2 W !!,"CMOR Patient Activity Score queued task #",ZTSK,!,"is currently running. Do not start another job at this time." S RUN=1 Q
25 .I ZTSK(1)=5 W !!,"CMOR Patient Activity Score queued task #",ZTSK,!,"was interrupted abnormally, possibly from a system error." D INT
26 I STATUS="SN" D
27 .S STOPDT=$P(NODE,U,3) I +STOPDT D
28 ..S STOPDT=$$FMTE^XLFDT(STOPDT,"1P")
29 ..W !!,"The CMOR patient activity score generator",!,"completed successfully on ",STOPDT,"."
30 .W !
31 .S DIR(0)="Y",DIR("A")="Would you like to reset all patient activity scores",DIR("B")="N" D ^DIR S RGY=Y
32 .I RGY=1 S DIR(0)="Y",DIR("A")="This will take quite a while. Are you sure",DIR("B")="N" D ^DIR S RGY=Y
33 .I RGY=1 S RUNTYPE="R",RGDFN=0 D TASK
34 I STATUS="SM"!(STATUS="INT") D
35 .S STOPDT=$P(NODE,U,3) D
36 ..I +STOPDT S STOPDT=$$FMTE^XLFDT(STOPDT,"1P")
37 ..W !!,"The CMOR patient activity score generator was "
38 ..W:STATUS="SM" ! W $S(STATUS="SM":"STOPPED MANUALLY",1:"INTERRUPTED ABNORMALLY.") I STATUS="SM" W " on ",STOPDT,"."
39 .I +$P(NODE,U) D
40 ..S LASTDFN=$P(NODE,U),LASTPT=$P($G(^DPT(+LASTDFN,0)),U),LASTSSN=$P(^(0),U,9)
41 ..W !,"The last patient processed was ",LASTPT," SSN: ",LASTSSN,!?31,"[RECORD# ",LASTDFN,"]"
42 .W ! S DIR(0)="Y",DIR("A")="Would you like to start with this patient and continue",DIR("B")="N" D ^DIR S RGY=Y
43 .W ! I RGY=1 D
44 ..S DIR(0)="Y",DIR("A")="This will take quite a while. Are you sure"
45 ..S DIR("B")="N" D ^DIR I Y=1 S RUNTYPE="RS",RGDFN=LASTDFN D TASK
46 .W ! I RGY=0 D
47 ..S DIR(0)="Y",DIR("A")="Would you like to rerun the CMOR calculation for all patients"
48 ..S DIR("B")="N" D ^DIR I Y=1 D
49 ...W ! S DIR(0)="Y",DIR("A")="This will take quite a while. Are you sure",DIR("B")="N" D ^DIR I Y=1 S RUNTYPE="RS",RGDFN=0 D TASK
50 G QUIT
51STOP ; entry point to flag a running cmor score initialization to stop
52 S U="^"
53 S NODE=$G(^RGSITE(991.8,1,"CMOR"))
54 I $P(NODE,U,7)'="R" W !,"The CMOR activity score generation is NOT running." G QUIT
55 W !,"This option will stop the CMOR patient activity score generation"
56 W !,"after it has completed calculating and filing the score for the current"
57 W !,"patient."
58 W ! S DIR("A")="Are you sure you want to do this",DIR("B")="N",DIR(0)="Y" D ^DIR K DIR S RGY=Y
59 W ! S DIR("A")="Stop patient activity score generation after the current patient",DIR("B")="N",DIR(0)="Y" D ^DIR S RGY=Y
60 ;I RGY=1 S DA=1,DIE="^RGSITE(991.8,",DR="21////Y;24////SM" D ^DIE
61 I RGY=1 D
62 .S $P(^RGSITE(991.8,1,"CMOR"),U,4)="Y"
63 .W !!,"CMOR patient activity generation is flagged to stop after"
64 .W !,"it has completed the current patient. This may take a short time."
65 .W !,"Please check the status later."
66 G QUIT
67INDIV ; entry point to allow a cmor score for an individual patient to be
68 ; calculated and filed
69 N MNODE
70 S U="^"
71 S DIC="^DPT(",DIC(0)="AEQMNZ" D ^DIC K DIC Q:+Y<0 S RGDFN=+Y
72 S PTNAM=$P(Y(0),"^"),SSN=$P(Y(0),"^",9),FILE=1
73 S MNODE=$$MPINODE^MPIFAPI(RGDFN)
74 I $P($G(MNODE),U,7)'="" D
75 .S FILE=0
76 .S SCOREDT=$$FMTE^XLFDT($P(MNODE,U,7),"1P")
77 .S CURSCORE=$P(MNODE,U,6) W !!,"This patient has an existing CMOR score of ",+CURSCORE," calculated on ",SCOREDT,".",!
78 .S DIR(0)="Y",DIR("A")="Do you want to calculate and file a new score for this patient",DIR("B")="NO" D ^DIR I Y=1 S FILE=1
79 I FILE=1 D
80 .W !!,"Working. Please standby..." S FILEFLG=0 D CALCI^RGVCCMR2
81 .I 'FILEFLG W !!,"No Patient Activity in the Past Three Years - No Score Filed!" Q
82 .W !!,"CMOR Activity Score: ",SCORE," filed for ",PTNAM," SSN: ",SSN,"."
83 G QUIT
84DISPLAY ; displays the status of the background cmor score initialization
85 W !,"The CMOR Activity Score Generator",!
86 ;count number of CMOR scores"
87 W !,"..one moment please...",!
88 S (SCORE,CNT)=0
89 F S SCORE=$O(^DPT("ACMORS",SCORE)) Q:'SCORE D
90 .S RGDFN=0 F S RGDFN=$O(^DPT("ACMORS",SCORE,RGDFN)) Q:'RGDFN D
91 ..S CNT=CNT+1
92 W !,"There are ",$P(^DPT(0),U,4)," records in your PATIENT file."
93 W !,"The last record number is ",$P(^DPT(0),U,3),"."
94 I $P($G(^RGSITE(991.8,1,"CMOR")),U)'="" D CHKSTAT
95 I $P($G(^RGSITE(991.8,1,"CMOR")),U)="" D
96 . W !,"The CMOR Calculation has NEVER been run on your system."
97 G QUIT
98CHKSTAT S NODE=$G(^RGSITE(991.8,1,"CMOR"))
99 S PTNAM="-Unknown-",SSN="---"
100 S RGDFN=+NODE I RGDFN,$D(^DPT(RGDFN,0)) D
101 .S PTNAM=$P(^(0),U),SSN=$P(^(0),U,9)
102 S OSTARTED="UNSPECIFIED" I $P(NODE,U,2)'="" D
103 .S OSTARTED=$$FMTE^XLFDT($P(NODE,U,2),"1P")
104 S OSTOPPED="UNSPECIFIED" I $P(NODE,U,3)'="" D
105 .S OSTOPPED=$$FMTE^XLFDT($P(NODE,U,3),"1P")
106 S ORESTART=$G(^XTMP("RGVCCMR","@@@@","RESTARTED"))
107 I +ORESTART S ORESTART=$$FMTE^XLFDT(ORESTART,"1P")
108 S ODFNCT=""
109 I $D(^XTMP("RGVCCMR","@@@@","DFNCOUNT")) S ODFNCT=^XTMP("RGVCCMR","@@@@","DFNCOUNT")
110STATUS S ST=$P(NODE,U,7)
111 ;if status is RUNNING, check to see if task errored out
112 I ST="R" D
113 .S ZTSK=$P(NODE,U,9) I $D(ZTSK) D
114 ..D STAT^%ZTLOAD
115 ..I ZTSK(1)=5 D INT S ST="INT"
116 S STATUS=$S(ST="R":"RUNNING.",ST="SM":"STOPPED MANUALLY",ST="SN":"SUCCESSFULLY COMPLETED",ST="INT":"INTERRUPTED ABNORMALLY.",1:"- NO STATUS LISTED -")
117 ;S PERCOMP=((ODFNCT/$P(^DPT(0),U,4))*100),PERCOMP=$P(PERCOMP,".")_"."_$E($P(PERCOMP,".",2),1,2)
118 W !,"Last Patient Processed: ",PTNAM," SSN: ",SSN," [RECORD# ",RGDFN,"]"
119 W !!,"The CMOR score initialization last started on ",OSTARTED,"."
120 I ORESTART]"" W !,"Job was restarted on ",ORESTART,"."
121 I +ODFNCT W !,ODFNCT," patient records have been processed."
122 W !,"Status: ",STATUS I ST'="R"&(ST'="INT") W " on ",OSTOPPED,"."
123 W !,"CMOR Score Count: ",CNT
124 ;
125 G QUIT
126 ;
127INT ;Set status to INTERRUPTED for abnormally stopped jobs
128 S $P(^RGSITE(991.8,1,"CMOR"),"^",7)="INT"
129 S STATUS="INT"
130 Q
131TASK S ZTIO="",ZTRTN="^RGVCCMR2",ZTDESC="BACKGROUND CMOR SCORE CALCULATOR"
132 S (ZTSAVE("RUNTYPE"),ZTSAVE("RGDFN"))=""
133 ; change ztsave("*")="" to specific variables when done
134 D ^%ZTLOAD
135 I $D(ZTSK) W " Task#, ",ZTSK," queued" S $P(^RGSITE(991.8,1,"CMOR"),U,9)=ZTSK
136 D ^%ZISC
137 Q
138QUIT K RGDFN,DIC,DIR,FILE,LASTDFN,LASTPT,LASTSSN,ODFNCT,ORESTART,OSTARTED
139 K OSTOPPED,PTNAM,RUNTYPE,SCORE,SSN,ST,STATUS,X,Y,%DT,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
140 K CURSCORE,SCOREDT,NODE,STOPDT,FILEFLG,SCORE,CNT,RGDFN,RUN
141 ;kill variables leftover from the CALI^RGVCCMR2 entry point
142 K LRCODE,DA,DR,DIE,APSTDT,LRCODE,LRSCORE,NXPC,NXPTF,NXSCE,NXRX,NXXR,PCCODE,PSOVER,PTF0,RXDT,STDT,XRCODE,XRSTDT,YR
143 Q
Note: See TracBrowser for help on using the repository browser.