source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTDPSC.m@ 1147

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1RGMTDPSC ;GAI/TMG-COUNT DUPLICATE RECORD ENTRIES BY CMOR SCORE RANGE ;5/30/98
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**19**;30 Apr 99
3 ;
4 ;Reference to ^VA(15 supported by IA #2532
5 ;Reference to ^DPT("ACMORS" and ^DPT(0 supported by IA #2070
6 ;
7 ;; search the Duplicate Record file (#15) for duplicate pairs and
8 ;; display by CMOR activity score range. The ranges are in 100's with
9 ;; a separate range for pairs where both members have no score and where
10 ;; both members have zero score or one member has a zero score and the
11 ;; other has no score.
12 ;;
13EN ; que or select device for output
14 I '$D(^DPT("ACMORS")) D Q
15 . W !,"The option, Start/Restart CMOR Score Calculation"
16 . W !,"[RG CMOR START], needs to be run before this option."
17 S %ZIS="QM" D ^%ZIS Q:POP S:IO'=IO(0) IO("Q")="" I '$D(IO("Q")) G SCAN
18 S ZTRTN="SCAN^RGMTDPSC"
19 S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("IO*")=""
20 S ZTDESC="DUP. RECORD REPORT BY CMOR SCORE" D ^%ZTLOAD,EXIT,^%ZISC
21 Q
22 ;
23SCAN ; search and count duplicate pairs by score ranges
24 S U="^",MSG=0,MSGLINE=1,DPTCNT=0 K SCRARR
25 N NODE1,NODE2
26 S IEN=0 F S IEN=$O(^VA(15,IEN)) Q:+IEN'>0 I $D(^VA(15,+IEN,0)) S NODE=^(0) D
27 . S (SCRANGE,SCORE,SCORE1,SCORE2)="NO SCORE"
28 . S DPT1=+$P(NODE,U),DPT2=+$P(NODE,U,2)
29 . S NODE1=$$MPINODE^MPIFAPI(+DPT1)
30 . I $P($G(NODE1),U,6)'="" S SCORE1=$P(NODE1,U,6)
31 . S NODE2=$$MPINODE^MPIFAPI(+DPT2)
32 . I $P($G(NODE2),U,6)'="" S SCORE2=$P(NODE2,U,6)
33 . I SCORE1=0&(SCORE2=0) S (SCRANGE,SCORE)="ZERO"
34 . I SCORE1?.N!(SCORE2?.N) D
35 . . Q:SCRANGE="ZERO"
36 . . S:+SCORE1>+SCORE SCORE=SCORE1 S:+SCORE2>+SCORE SCORE=SCORE2 S SCRANGE=SCORE\100 I SCRANGE>0 S SCRANGE=SCRANGE*100
37 . S:'$D(SCRARR("RANGE",SCRANGE)) SCRARR("RANGE",SCRANGE)=0
38 . S SCRARR("RANGE",SCRANGE)=SCRARR("RANGE",SCRANGE)+1
39 D PRINT
40 ;
41EXIT K COUNT,DPT1,DPT2,DPTCNT,IEN,MSG,MSGLINE,NODE,PAGE,POP,PRANGE,PRDT,SCORE
42 K SCORE1,SCORE2,SCRANGE,SCRARR,S,TXT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZZ,%DT,%ZIS,DTOUT,DUOUT,SITE,XMSUB,XMTEXT,XMY,XMDUZ
43 S:$D(ZTQUEUED) ZTREQ="@"
44 Q
45 ;
46PRINT ; print duplicate pair counts by score range
47 S (PAGE,COUNT)=0 S X="N",%DT="T" D ^%DT S X=Y X ^DD("DD") S PRDT=Y
48 D HDR I MSG=0 D MSG
49 I $D(SCRARR("RANGE","ZERO")) D
50 . S PRANGE="0" W !?10,PRANGE,?40,$J(SCRARR("RANGE","ZERO"),6,0)
51 . S COUNT=COUNT+SCRARR("RANGE","ZERO")
52 S SCRANGE="" F S SCRANGE=$O(SCRARR("RANGE",SCRANGE)) Q:SCRANGE="" Q:SCRANGE="ZERO" D
53 . I SCRANGE=0 S PRANGE="1 - 99"
54 . I SCRANGE'="NO SCORE" I SCRANGE>0 S PRANGE=SCRANGE_" - "_(SCRANGE+99)
55 . I SCRANGE="NO SCORE" S PRANGE=SCRANGE
56 . S MSGLINE=MSGLINE+.001
57 . S TXT(MSGLINE)=$J(" ",10)_PRANGE_$J(" ",23)_$J(SCRARR("RANGE",SCRANGE),6,0)
58 . D:$Y>(IOSL-6) HDR W !?10,PRANGE,?39,$J(SCRARR("RANGE",SCRANGE),6,0) S COUNT=COUNT+SCRARR("RANGE",SCRANGE)
59 S DPTCNT=$P(^DPT(0),U,4)
60 D:$Y>(IOSL-6) HDR W !!,"TOTAL Potential Duplicates (15): ",?39,$J(COUNT,6,0)
61 D:$Y>(IOSL-6) HDR W !,"TOTAL Patients (2): ",?39,$J(DPTCNT,6,0)
62 S MSGLINE=MSGLINE+.001 D
63 . S TXT(MSGLINE)=" ",MSGLINE=MSGLINE+.001
64 . S TXT(MSGLINE)="TOTAL Potential Duplicates (15) "_COUNT
65 . S MSGLINE=MSGLINE+.001
66 . S TXT(MSGLINE)="TOTAL Patients (2) "_DPTCNT
67 D MSG1
68 Q
69 ;
70HDR I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
71 . S DIR(0)="E" D ^DIR K DIR
72 Q:$D(DUOUT)!($D(DTOUT))
73 S PAGE=PAGE+1 W #
74 W "Duplicate Record Count by CMOR Score",?(IOM-23),"Page: ",PAGE
75 W !?(IOM-23),"Date: ",PRDT,!
76 F ZZ=1:1:IOM W "-"
77 I PAGE=1 D
78 .W !,"This report is drawn from the Duplicate Record file (#15) with"
79 .W !,"CMOR scores from the PATIENT file, CMOR ACTIVITY SCORE field.",!
80 .W !,"- If both members of a pair have a score of zero the pair is"
81 .W !," counted in the '0' group."
82 .W !,"- If one or both members of the pair have a score greater than"
83 .W !," zero, that pair is counted in the group for the higher score."
84 .W !,"- If neither member of the pair have a CMOR score, the pair is"
85 .W !," counted in the 'NO SCORE' group."
86 W !!,?10,"Score Range",?40,"Count",!?10,"-----------",?40,"-----",!
87 Q
88MSG ;create the message
89 S TXT(.1)="Duplicate Record Count by CMOR Score"_$J(" ",20)_"Date: "_PRDT
90 S TXT(.2)=" "
91 S SITE=$$SITE^VASITE()
92 S TXT(.3)=$P(SITE,U,2)_" ("_$P(SITE,U)_")"
93 S TXT(.4)=" "
94 S TXT(.5)=$J(" ",10)_"Score Range"_$J(" ",20)_"Count"
95 S TXT(.6)=$J(" ",10)_"-----------"_$J(" ",20)_"-----"
96 S TXT(.7)=" "
97 Q
98MSG1 ;call XMD
99 S XMSUB="Duplicate Records by CMOR Score: "_$P(SITE,U,2)
100 S XMY(DUZ)="",XMDUZ=DUZ
101 S XMTEXT="TXT(" D ^XMD
102 Q
Note: See TracBrowser for help on using the repository browser.