- 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 Jan 18, 2025@03:03:04 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