Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMRTSR

IVMRTSR.m

Go to the documentation of this file.
  1. IVMRTSR ;ALB/KCL - Report of IVM Transmissions ; 30 April 1993
  1. ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
  1. ;
  1. EN ; Entry point
  1. W !!,"Income Verification Match - Transmission Report"
  1. S DIR(0)="S^1:SINGLE DATE REPORT;2:DATE RANGE REPORT"
  1. D ^DIR I 'Y!$D(DIRUT) G ENQ
  1. S IVMFLG=+Y
  1. ;
  1. ; Get report run dates
  1. D BEG I 'Y!$D(DIRUT) G ENQ
  1. I IVMFLG=1 S IVMEND=IVMBEG
  1. I IVMFLG=2 D END I 'Y!$D(DIRUT) G ENQ
  1. ;
  1. ; Select device for queueing/printing report
  1. S IVMRTN="SORT^IVMRTSR",ZTDESC="IVM TRANSMISSION REPORT"
  1. S ZTSAVE("IVMBEG")="",ZTSAVE("IVMEND")="",ZTSAVE("IVMFLG")=""
  1. D ^IVMUTQ
  1. ;
  1. ENQ ; Cleanup
  1. K DA,DIRUT,IVMI,IVMA,IVMC,IVMBEG,IVMDATE,IVMEND,IVMNODE,IVMNODE1,IVMREC,IVMRTN,IVMTRD
  1. K X,X1,X2,^TMP("IVMRTSR",$J),IVMSTAT,IVMCNTS
  1. Q
  1. ;
  1. ;
  1. BEG ; Enter Begin date for report
  1. 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
  1. I IVMBEG>DT W !,?5,"Future dates are not allowed.",*7 K IVMBEG G BEG
  1. BEGQ Q
  1. ;
  1. END ; Select ending date for report
  1. S DIR(0)="DA^"_IVMBEG_":NOW:EX",DIR("A")="Enter End DATE: ",DIR("?")="^D HELP^%DTC" D ^DIR K DIR S IVMEND=+Y
  1. Q
  1. ;
  1. ;
  1. SORT ; Sort data for report
  1. K ^TMP("IVMRTSR",$J)
  1. S (IVMI,IVMCNT,IVMCNT1,IVMA,IVMC,IVMNIN,IVMIN,IVMCNIN,IVMCIN)=0
  1. 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
  1. .S IVMNODE=$G(^IVM(301.6,IVMI,0)),IVMNODE1=$G(^(1))
  1. .S IVMCNT=IVMCNT+1 ; Count the number of transmissions
  1. .I '$D(^TMP("IVMRTSR",$J,+IVMNODE)) S IVMCNT1=IVMCNT1+$$RETRANS(+IVMNODE,IVMI,IVMEND) ; Count multiple transmissions
  1. .;
  1. .; Count the category A's with/without insurance
  1. .I $P(IVMNODE1,"^",1)=4,$P(IVMNODE1,"^",2) S IVMIN=IVMIN+1
  1. .I $P(IVMNODE1,"^",1)=4,'$P(IVMNODE1,"^",2) S IVMNIN=IVMNIN+1
  1. .;
  1. .; Now count the category C's with/without insurance
  1. .I $P(IVMNODE1,"^",1)=6,'$P(IVMNODE1,"^",2) S IVMCNIN=IVMCNIN+1
  1. .I $P(IVMNODE1,"^",1)=6,$P(IVMNODE1,"^",2) S IVMCIN=IVMCIN+1
  1. .;
  1. .; Determine the transmission status and count
  1. .S IVMSTAT=$P(IVMNODE,"^",3)
  1. .I IVMSTAT=""!(("^0^1^2^3^")'[("^"_IVMSTAT_"^")) S IVMCNTS("NO")=$G(IVMCNTS("NO"))+1 Q
  1. .S IVMCNTS(IVMSTAT)=$G(IVMCNTS(IVMSTAT))+1
  1. ;
  1. AVG ; If a date range report DO calculations
  1. I IVMFLG=2,IVMCNT D
  1. .S X1=IVMEND,X2=IVMBEG D ^%DTC S IVMRNG=$G(X)+1 ; Get number of days included in date range
  1. .;
  1. .S IVMPERA=((IVMIN/IVMCNT)*100),IVMPERC1=((IVMCIN/IVMCNT)*100) ; %A and %C with insurance
  1. .S IVMPERB=((IVMNIN/IVMCNT)*100),IVMPERC=((IVMCNIN/IVMCNT)*100) ; %A and %C with no insurance
  1. ;
  1. ; Call print portion of report
  1. D EN^IVMRTSR1
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. D ENQ
  1. Q
  1. ;
  1. RETRANS(IVMDATE,IVMREC,IVMEND) ; Extrinsic function that returns the number of retransmissions for a given IVM TRANSMISSION LOG entry
  1. N RESULT,IVMRETR
  1. S IVMRETR=0 ; Retransmission counter
  1. S ^TMP("IVMRTSR",$J,IVMDATE)=""
  1. F S IVMREC=$O(^IVM(301.6,"B",IVMDATE,IVMREC)) Q:'IVMREC D
  1. .S RESULT=$P($G(^IVM(301.6,IVMREC,0)),"^",2)
  1. .I RESULT<(IVMEND+.9) S IVMRETR=IVMRETR+1
  1. Q IVMRETR