source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMRTSR.m@ 1005

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

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1IVMRTSR ;ALB/KCL - Report of IVM Transmissions ; 30 April 1993
2 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
3 ;
4EN ; Entry point
5 W !!,"Income Verification Match - Transmission Report"
6 S DIR(0)="S^1:SINGLE DATE REPORT;2:DATE RANGE REPORT"
7 D ^DIR I 'Y!$D(DIRUT) G ENQ
8 S IVMFLG=+Y
9 ;
10 ; Get report run dates
11 D BEG I 'Y!$D(DIRUT) G ENQ
12 I IVMFLG=1 S IVMEND=IVMBEG
13 I IVMFLG=2 D END I 'Y!$D(DIRUT) G ENQ
14 ;
15 ; Select device for queueing/printing report
16 S IVMRTN="SORT^IVMRTSR",ZTDESC="IVM TRANSMISSION REPORT"
17 S ZTSAVE("IVMBEG")="",ZTSAVE("IVMEND")="",ZTSAVE("IVMFLG")=""
18 D ^IVMUTQ
19 ;
20ENQ ; Cleanup
21 K DA,DIRUT,IVMI,IVMA,IVMC,IVMBEG,IVMDATE,IVMEND,IVMNODE,IVMNODE1,IVMREC,IVMRTN,IVMTRD
22 K X,X1,X2,^TMP("IVMRTSR",$J),IVMSTAT,IVMCNTS
23 Q
24 ;
25 ;
26BEG ; Enter Begin date for report
27 S DIR(0)="DO^::EX",DIR("A")="Enter "_$S(IVMFLG=2:"Start ",1:"")_"DATE",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G:'Y!$D(DIRUT) BEGQ S IVMBEG=+Y
28 I IVMBEG>DT W !,?5,"Future dates are not allowed.",*7 K IVMBEG G BEG
29BEGQ Q
30 ;
31END ; Select ending date for report
32 S DIR(0)="DA^"_IVMBEG_":NOW:EX",DIR("A")="Enter End DATE: ",DIR("?")="^D HELP^%DTC" D ^DIR K DIR S IVMEND=+Y
33 Q
34 ;
35 ;
36SORT ; Sort data for report
37 K ^TMP("IVMRTSR",$J)
38 S (IVMI,IVMCNT,IVMCNT1,IVMA,IVMC,IVMNIN,IVMIN,IVMCNIN,IVMCIN)=0
39 S IVMTRD=IVMBEG-.1 F S IVMTRD=$O(^IVM(301.6,"ADT",IVMTRD)) Q:'IVMTRD!(IVMTRD>(IVMEND+.9)) S IVMI=0 F S IVMI=$O(^IVM(301.6,"ADT",IVMTRD,IVMI)) Q:'IVMI D
40 .S IVMNODE=$G(^IVM(301.6,IVMI,0)),IVMNODE1=$G(^(1))
41 .S IVMCNT=IVMCNT+1 ; Count the number of transmissions
42 .I '$D(^TMP("IVMRTSR",$J,+IVMNODE)) S IVMCNT1=IVMCNT1+$$RETRANS(+IVMNODE,IVMI,IVMEND) ; Count multiple transmissions
43 .;
44 .; Count the category A's with/without insurance
45 .I $P(IVMNODE1,"^",1)=4,$P(IVMNODE1,"^",2) S IVMIN=IVMIN+1
46 .I $P(IVMNODE1,"^",1)=4,'$P(IVMNODE1,"^",2) S IVMNIN=IVMNIN+1
47 .;
48 .; Now count the category C's with/without insurance
49 .I $P(IVMNODE1,"^",1)=6,'$P(IVMNODE1,"^",2) S IVMCNIN=IVMCNIN+1
50 .I $P(IVMNODE1,"^",1)=6,$P(IVMNODE1,"^",2) S IVMCIN=IVMCIN+1
51 .;
52 .; Determine the transmission status and count
53 .S IVMSTAT=$P(IVMNODE,"^",3)
54 .I IVMSTAT=""!(("^0^1^2^3^")'[("^"_IVMSTAT_"^")) S IVMCNTS("NO")=$G(IVMCNTS("NO"))+1 Q
55 .S IVMCNTS(IVMSTAT)=$G(IVMCNTS(IVMSTAT))+1
56 ;
57AVG ; If a date range report DO calculations
58 I IVMFLG=2,IVMCNT D
59 .S X1=IVMEND,X2=IVMBEG D ^%DTC S IVMRNG=$G(X)+1 ; Get number of days included in date range
60 .;
61 .S IVMPERA=((IVMIN/IVMCNT)*100),IVMPERC1=((IVMCIN/IVMCNT)*100) ; %A and %C with insurance
62 .S IVMPERB=((IVMNIN/IVMCNT)*100),IVMPERC=((IVMCNIN/IVMCNT)*100) ; %A and %C with no insurance
63 ;
64 ; Call print portion of report
65 D EN^IVMRTSR1
66 ;
67 I $D(ZTQUEUED) S ZTREQ="@"
68 D ENQ
69 Q
70 ;
71RETRANS(IVMDATE,IVMREC,IVMEND) ; Extrinsic function that returns the number of retransmissions for a given IVM TRANSMISSION LOG entry
72 N RESULT,IVMRETR
73 S IVMRETR=0 ; Retransmission counter
74 S ^TMP("IVMRTSR",$J,IVMDATE)=""
75 F S IVMREC=$O(^IVM(301.6,"B",IVMDATE,IVMREC)) Q:'IVMREC D
76 .S RESULT=$P($G(^IVM(301.6,IVMREC,0)),"^",2)
77 .I RESULT<(IVMEND+.9) S IVMRETR=IVMRETR+1
78 Q IVMRETR
Note: See TracBrowser for help on using the repository browser.