IVMRTSR ;ALB/KCL - Report of IVM Transmissions ; 30 April 1993
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;
EN ; Entry point
W !!,"Income Verification Match - Transmission Report"
S DIR(0)="S^1:SINGLE DATE REPORT;2:DATE RANGE REPORT"
D ^DIR I 'Y!$D(DIRUT) G ENQ
S IVMFLG=+Y
;
; Get report run dates
D BEG I 'Y!$D(DIRUT) G ENQ
I IVMFLG=1 S IVMEND=IVMBEG
I IVMFLG=2 D END I 'Y!$D(DIRUT) G ENQ
;
; Select device for queueing/printing report
S IVMRTN="SORT^IVMRTSR",ZTDESC="IVM TRANSMISSION REPORT"
S ZTSAVE("IVMBEG")="",ZTSAVE("IVMEND")="",ZTSAVE("IVMFLG")=""
D ^IVMUTQ
;
ENQ ; Cleanup
K DA,DIRUT,IVMI,IVMA,IVMC,IVMBEG,IVMDATE,IVMEND,IVMNODE,IVMNODE1,IVMREC,IVMRTN,IVMTRD
K X,X1,X2,^TMP("IVMRTSR",$J),IVMSTAT,IVMCNTS
Q
;
;
BEG ; Enter Begin date for report
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
I IVMBEG>DT W !,?5,"Future dates are not allowed.",*7 K IVMBEG G BEG
BEGQ Q
;
END ; Select ending date for report
S DIR(0)="DA^"_IVMBEG_":NOW:EX",DIR("A")="Enter End DATE: ",DIR("?")="^D HELP^%DTC" D ^DIR K DIR S IVMEND=+Y
Q
;
;
SORT ; Sort data for report
K ^TMP("IVMRTSR",$J)
S (IVMI,IVMCNT,IVMCNT1,IVMA,IVMC,IVMNIN,IVMIN,IVMCNIN,IVMCIN)=0
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
.S IVMNODE=$G(^IVM(301.6,IVMI,0)),IVMNODE1=$G(^(1))
.S IVMCNT=IVMCNT+1 ; Count the number of transmissions
.I '$D(^TMP("IVMRTSR",$J,+IVMNODE)) S IVMCNT1=IVMCNT1+$$RETRANS(+IVMNODE,IVMI,IVMEND) ; Count multiple transmissions
.;
.; Count the category A's with/without insurance
.I $P(IVMNODE1,"^",1)=4,$P(IVMNODE1,"^",2) S IVMIN=IVMIN+1
.I $P(IVMNODE1,"^",1)=4,'$P(IVMNODE1,"^",2) S IVMNIN=IVMNIN+1
.;
.; Now count the category C's with/without insurance
.I $P(IVMNODE1,"^",1)=6,'$P(IVMNODE1,"^",2) S IVMCNIN=IVMCNIN+1
.I $P(IVMNODE1,"^",1)=6,$P(IVMNODE1,"^",2) S IVMCIN=IVMCIN+1
.;
.; Determine the transmission status and count
.S IVMSTAT=$P(IVMNODE,"^",3)
.I IVMSTAT=""!(("^0^1^2^3^")'[("^"_IVMSTAT_"^")) S IVMCNTS("NO")=$G(IVMCNTS("NO"))+1 Q
.S IVMCNTS(IVMSTAT)=$G(IVMCNTS(IVMSTAT))+1
;
AVG ; If a date range report DO calculations
I IVMFLG=2,IVMCNT D
.S X1=IVMEND,X2=IVMBEG D ^%DTC S IVMRNG=$G(X)+1 ; Get number of days included in date range
.;
.S IVMPERA=((IVMIN/IVMCNT)*100),IVMPERC1=((IVMCIN/IVMCNT)*100) ; %A and %C with insurance
.S IVMPERB=((IVMNIN/IVMCNT)*100),IVMPERC=((IVMCNIN/IVMCNT)*100) ; %A and %C with no insurance
;
; Call print portion of report
D EN^IVMRTSR1
;
I $D(ZTQUEUED) S ZTREQ="@"
D ENQ
Q
;
RETRANS(IVMDATE,IVMREC,IVMEND) ; Extrinsic function that returns the number of retransmissions for a given IVM TRANSMISSION LOG entry
N RESULT,IVMRETR
S IVMRETR=0 ; Retransmission counter
S ^TMP("IVMRTSR",$J,IVMDATE)=""
F S IVMREC=$O(^IVM(301.6,"B",IVMDATE,IVMREC)) Q:'IVMREC D
.S RESULT=$P($G(^IVM(301.6,IVMREC,0)),"^",2)
.I RESULT<(IVMEND+.9) S IVMRETR=IVMRETR+1
Q IVMRETR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMRTSR 3148 printed Dec 13, 2024@02:02:39 Page 2
IVMRTSR ;ALB/KCL - Report of IVM Transmissions ; 30 April 1993
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;
EN ; Entry point
+1 WRITE !!,"Income Verification Match - Transmission Report"
+2 SET DIR(0)="S^1:SINGLE DATE REPORT;2:DATE RANGE REPORT"
+3 DO ^DIR
IF 'Y!$DATA(DIRUT)
GOTO ENQ
+4 SET IVMFLG=+Y
+5 ;
+6 ; Get report run dates
+7 DO BEG
IF 'Y!$DATA(DIRUT)
GOTO ENQ
+8 IF IVMFLG=1
SET IVMEND=IVMBEG
+9 IF IVMFLG=2
DO END
IF 'Y!$DATA(DIRUT)
GOTO ENQ
+10 ;
+11 ; Select device for queueing/printing report
+12 SET IVMRTN="SORT^IVMRTSR"
SET ZTDESC="IVM TRANSMISSION REPORT"
+13 SET ZTSAVE("IVMBEG")=""
SET ZTSAVE("IVMEND")=""
SET ZTSAVE("IVMFLG")=""
+14 DO ^IVMUTQ
+15 ;
ENQ ; Cleanup
+1 KILL DA,DIRUT,IVMI,IVMA,IVMC,IVMBEG,IVMDATE,IVMEND,IVMNODE,IVMNODE1,IVMREC,IVMRTN,IVMTRD
+2 KILL X,X1,X2,^TMP("IVMRTSR",$JOB),IVMSTAT,IVMCNTS
+3 QUIT
+4 ;
+5 ;
BEG ; Enter Begin date for report
+1 SET DIR(0)="DO^::EX"
SET DIR("A")="Enter "_$SELECT(IVMFLG=2:"Start ",1:"")_"DATE"
SET DIR("?")="^D HELP^%DTC"
DO ^DIR
KILL DIR
if 'Y!$DATA(DIRUT)
GOTO BEGQ
SET IVMBEG=+Y
+2 IF IVMBEG>DT
WRITE !,?5,"Future dates are not allowed.",*7
KILL IVMBEG
GOTO BEG
BEGQ QUIT
+1 ;
END ; Select ending date for report
+1 SET DIR(0)="DA^"_IVMBEG_":NOW:EX"
SET DIR("A")="Enter End DATE: "
SET DIR("?")="^D HELP^%DTC"
DO ^DIR
KILL DIR
SET IVMEND=+Y
+2 QUIT
+3 ;
+4 ;
SORT ; Sort data for report
+1 KILL ^TMP("IVMRTSR",$JOB)
+2 SET (IVMI,IVMCNT,IVMCNT1,IVMA,IVMC,IVMNIN,IVMIN,IVMCNIN,IVMCIN)=0
+3 SET IVMTRD=IVMBEG-.1
FOR
SET IVMTRD=$ORDER(^IVM(301.6,"ADT",IVMTRD))
if 'IVMTRD!(IVMTRD>(IVMEND+.9))
QUIT
SET IVMI=0
FOR
SET IVMI=$ORDER(^IVM(301.6,"ADT",IVMTRD,IVMI))
if 'IVMI
QUIT
Begin DoDot:1
+4 SET IVMNODE=$GET(^IVM(301.6,IVMI,0))
SET IVMNODE1=$GET(^(1))
+5 ; Count the number of transmissions
SET IVMCNT=IVMCNT+1
+6 ; Count multiple transmissions
IF '$DATA(^TMP("IVMRTSR",$JOB,+IVMNODE))
SET IVMCNT1=IVMCNT1+$$RETRANS(+IVMNODE,IVMI,IVMEND)
+7 ;
+8 ; Count the category A's with/without insurance
+9 IF $PIECE(IVMNODE1,"^",1)=4
IF $PIECE(IVMNODE1,"^",2)
SET IVMIN=IVMIN+1
+10 IF $PIECE(IVMNODE1,"^",1)=4
IF '$PIECE(IVMNODE1,"^",2)
SET IVMNIN=IVMNIN+1
+11 ;
+12 ; Now count the category C's with/without insurance
+13 IF $PIECE(IVMNODE1,"^",1)=6
IF '$PIECE(IVMNODE1,"^",2)
SET IVMCNIN=IVMCNIN+1
+14 IF $PIECE(IVMNODE1,"^",1)=6
IF $PIECE(IVMNODE1,"^",2)
SET IVMCIN=IVMCIN+1
+15 ;
+16 ; Determine the transmission status and count
+17 SET IVMSTAT=$PIECE(IVMNODE,"^",3)
+18 IF IVMSTAT=""!(("^0^1^2^3^")'[("^"_IVMSTAT_"^"))
SET IVMCNTS("NO")=$GET(IVMCNTS("NO"))+1
QUIT
+19 SET IVMCNTS(IVMSTAT)=$GET(IVMCNTS(IVMSTAT))+1
End DoDot:1
+20 ;
AVG ; If a date range report DO calculations
+1 IF IVMFLG=2
IF IVMCNT
Begin DoDot:1
+2 ; Get number of days included in date range
SET X1=IVMEND
SET X2=IVMBEG
DO ^%DTC
SET IVMRNG=$GET(X)+1
+3 ;
+4 ; %A and %C with insurance
SET IVMPERA=((IVMIN/IVMCNT)*100)
SET IVMPERC1=((IVMCIN/IVMCNT)*100)
+5 ; %A and %C with no insurance
SET IVMPERB=((IVMNIN/IVMCNT)*100)
SET IVMPERC=((IVMCNIN/IVMCNT)*100)
End DoDot:1
+6 ;
+7 ; Call print portion of report
+8 DO EN^IVMRTSR1
+9 ;
+10 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+11 DO ENQ
+12 QUIT
+13 ;
RETRANS(IVMDATE,IVMREC,IVMEND) ; Extrinsic function that returns the number of retransmissions for a given IVM TRANSMISSION LOG entry
+1 NEW RESULT,IVMRETR
+2 ; Retransmission counter
SET IVMRETR=0
+3 SET ^TMP("IVMRTSR",$JOB,IVMDATE)=""
+4 FOR
SET IVMREC=$ORDER(^IVM(301.6,"B",IVMDATE,IVMREC))
if 'IVMREC
QUIT
Begin DoDot:1
+5 SET RESULT=$PIECE($GET(^IVM(301.6,IVMREC,0)),"^",2)
+6 IF RESULT<(IVMEND+.9)
SET IVMRETR=IVMRETR+1
End DoDot:1
+7 QUIT IVMRETR
