IVMRNQ ;ALB/CPM - IVM CASE INQUIRY ; 14-JUN-94
;;2.0; INCOME VERIFICATION MATCH ;**12,17**; 21-OCT-94
;
EN ; Main loop for the IVM Case Inquiry.
S IVMSTOP=0 F D PAT Q:IVMSTOP W !!
K IVMSTOP
Q
;
;
PAT ; Run inquiry for a single patient.
S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC I Y<1 S IVMSTOP=1 G END
S DFN=+Y,IVMDA=$O(^IVM(301.5,"B",DFN,0))
I 'IVMDA W !!,"This patient has had no Means/Copay Tests transmitted to HEC.",! G PAT
I '$O(^IVM(301.5,"B",DFN,IVMDA)) D G DEV
.S IVMYR=$P($G(^IVM(301.5,IVMDA,0)),"^",2)
.W !!," >>>> Case Record is for Income Year ",1700+$E(IVMYR,1,3)," <<<<",!
;
YR ; Get income year to select record.
N ENODE
S DIR("A")="Select INCOME YEAR: ",DIR(0)="DA^2901231::E",DIR("?")="^D HLP^IVMRNQ"
D ^DIR K DIR G:$D(DIRUT)!('Y) END
S IVMYR=$E(Y,1,3)_"0000",IVMDA=$O(^IVM(301.5,"APT",DFN,IVMYR,0))
I 'IVMDA W !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$E(IVMYR,1,3),".",! G YR
S ENODE=$G(^IVM(301.5,IVMDA,"E"))
I (ENODE'=""),'(+$P(ENODE,"^")) W !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$E(IVMYR,1,3),".",! G YR
;
DEV ; Select an output device.
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q") D HOME^%ZIS,END G END
.S ZTRTN="DQ^IVMRNQ",ZTDESC="IVM - CASE INQUIRY"
.S (ZTSAVE("IVMYR"),ZTSAVE("IVMDA"),ZTSAVE("DFN"))=""
;
U IO
;
DQ ; Tasked entry point.
S IVMPAG=0,IVMNAM=$$PT^IVMUFNC4(DFN),IVM0=$G(^IVM(301.5,IVMDA,0)),IVM1=$G(^(1))
D NOW^%DTC S IVMDAT=$$FMTE^XLFDT(%),IVMQUIT=0
S IVMMT=$$LST^DGMTU(DFN,$E(IVMYR,1,3)+1_1231)
D HDR^IVMRNQ1
;
; - list transmission history
I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
D THDR^IVMRNQ1
S IVMTR=0 F S IVMTR=$O(^IVM(301.6,"B",IVMDA,IVMTR)) Q:'IVMTR D G:IVMQUIT END
.S IVMTR0=$G(^IVM(301.6,IVMTR,0)),IVMTR1=$G(^(1))
.I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,THDR^IVMRNQ1
.W !?2,$$FMTE^XLFDT($P(IVMTR0,"^",2))
.W ?25,$$EXPAND^IVMUFNC(301.6,.03,$P(IVMTR0,"^",3))
.W ?53,$S(IVMTR1:$E($P($$MTS^DGMTU("",+IVMTR1),"^"),1,13),1:"UNKNOWN")
.W ?67,$S($P(IVMTR1,"^",2):"YES",1:"NO")
.I $P(IVMTR0,"^",4)]"" D
..I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,THDR^IVMRNQ1
..W !?4,"Error: ",$E($P(IVMTR0,"^",4),1,70)
;
; - list billing history
I '$O(^IVM(301.61,"C",DFN,0)) G UPL
I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
D BHDR^IVMRNQ1
S IVMTR=0 F S IVMTR=$O(^IVM(301.61,"C",DFN,IVMTR)) Q:'IVMTR D G:IVMQUIT END
.S IVMTR0=$G(^IVM(301.61,IVMTR,0))
.I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,BHDR^IVMRNQ1
.W !?2,$$EXPAND^IVMUFNC(301.61,.04,$P(IVMTR0,"^",4))
.W ?14,$$DAT1^IVMUFNC4($P(IVMTR0,"^",5))
.W ?24,$$DAT1^IVMUFNC4($P(IVMTR0,"^",6))
.W ?34,$J($P(IVMTR0,"^",8),8,2)
.W ?44,$S($P(IVMTR0,"^",4)>1:" N/A",1:$J($P(IVMTR0,"^",9),8,2))
.W ?55,$S($P(IVMTR0,"^",11):"YES",1:"NO")
.W ?63,$S($P(IVMTR0,"^",10):"YES",1:"NO")
.W ?70,$S($P(IVMTR0,"^",13):$$DAT1^IVMUFNC4($P(IVMTR0,"^",13)),1:"Not Sent")
;
UPL ; - check for upload information
D CKUPL^IVMRNQ1 I '$D(IVMTXT) G END1
I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
;
W !
F IVMS=1,2,3 I $D(IVMTXT(IVMS)) W !,$P($T(UPTXT+IVMS^IVMRNQ1),";;",2)
S IVMS=0 F S IVMS=$O(IVMTXT(4,IVMS)) Q:'IVMS S IVMX=IVMTXT(4,IVMS) D
.I $P(IVMX,"^",5) W !,"Insurance data was uploaded on ",$$DAT1^IVMUFNC4($P(IVMX,"^",5),1),"."
.I $P(IVMX,"^",8) W !,"Insurance data for this patient was rejected: ",$P($G(^IVM(301.91,$P(IVMX,"^",8),0)),"^",2)
;
END1 D PAUSE^IVMRUTL
;
END I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K %DT,DFN,IVMYR,IVMDA,IVMPAG,IVMNAM,IVM0,IVM1,IVMDAT,IVMMT,X,Y,ZTSK
K IVMTR,IVMTR0,IVMTR1,IVMI,IVMX,DIRUT,DUOUT,DTOUT,IVMS,IVMTXT
Q
;
HLP ; Help to select Income Year.
N I
W !!,"Please select one of the following Income Years:",!
S I=0 F S I=$O(^IVM(301.5,"APT",DFN,I)) Q:'I I I>2900000 W !?4,$E(I,1,3)+1700
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMRNQ 3975 printed Dec 13, 2024@02:02:37 Page 2
IVMRNQ ;ALB/CPM - IVM CASE INQUIRY ; 14-JUN-94
+1 ;;2.0; INCOME VERIFICATION MATCH ;**12,17**; 21-OCT-94
+2 ;
EN ; Main loop for the IVM Case Inquiry.
+1 SET IVMSTOP=0
FOR
DO PAT
if IVMSTOP
QUIT
WRITE !!
+2 KILL IVMSTOP
+3 QUIT
+4 ;
+5 ;
PAT ; Run inquiry for a single patient.
+1 SET DIC="^DPT("
SET DIC(0)="AEQMN"
DO ^DIC
KILL DIC
IF Y<1
SET IVMSTOP=1
GOTO END
+2 SET DFN=+Y
SET IVMDA=$ORDER(^IVM(301.5,"B",DFN,0))
+3 IF 'IVMDA
WRITE !!,"This patient has had no Means/Copay Tests transmitted to HEC.",!
GOTO PAT
+4 IF '$ORDER(^IVM(301.5,"B",DFN,IVMDA))
Begin DoDot:1
+5 SET IVMYR=$PIECE($GET(^IVM(301.5,IVMDA,0)),"^",2)
+6 WRITE !!," >>>> Case Record is for Income Year ",1700+$EXTRACT(IVMYR,1,3)," <<<<",!
End DoDot:1
GOTO DEV
+7 ;
YR ; Get income year to select record.
+1 NEW ENODE
+2 SET DIR("A")="Select INCOME YEAR: "
SET DIR(0)="DA^2901231::E"
SET DIR("?")="^D HLP^IVMRNQ"
+3 DO ^DIR
KILL DIR
if $DATA(DIRUT)!('Y)
GOTO END
+4 SET IVMYR=$EXTRACT(Y,1,3)_"0000"
SET IVMDA=$ORDER(^IVM(301.5,"APT",DFN,IVMYR,0))
+5 IF 'IVMDA
WRITE !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$EXTRACT(IVMYR,1,3),".",!
GOTO YR
+6 SET ENODE=$GET(^IVM(301.5,IVMDA,"E"))
+7 IF (ENODE'="")
IF '(+$PIECE(ENODE,"^"))
WRITE !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$EXTRACT(IVMYR,1,3),".",!
GOTO YR
+8 ;
DEV ; Select an output device.
+1 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="DQ^IVMRNQ"
SET ZTDESC="IVM - CASE INQUIRY"
+4 SET (ZTSAVE("IVMYR"),ZTSAVE("IVMDA"),ZTSAVE("DFN"))=""
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q")
DO HOME^%ZIS
DO END
GOTO END
+5 ;
+6 USE IO
+7 ;
DQ ; Tasked entry point.
+1 SET IVMPAG=0
SET IVMNAM=$$PT^IVMUFNC4(DFN)
SET IVM0=$GET(^IVM(301.5,IVMDA,0))
SET IVM1=$GET(^(1))
+2 DO NOW^%DTC
SET IVMDAT=$$FMTE^XLFDT(%)
SET IVMQUIT=0
+3 SET IVMMT=$$LST^DGMTU(DFN,$EXTRACT(IVMYR,1,3)+1_1231)
+4 DO HDR^IVMRNQ1
+5 ;
+6 ; - list transmission history
+7 IF $Y>(IOSL-6)
DO PAUSE^IVMRUTL
if IVMQUIT
GOTO END
DO HDR^IVMRNQ1
+8 DO THDR^IVMRNQ1
+9 SET IVMTR=0
FOR
SET IVMTR=$ORDER(^IVM(301.6,"B",IVMDA,IVMTR))
if 'IVMTR
QUIT
Begin DoDot:1
+10 SET IVMTR0=$GET(^IVM(301.6,IVMTR,0))
SET IVMTR1=$GET(^(1))
+11 IF $Y>(IOSL-3)
DO PAUSE^IVMRUTL
if IVMQUIT
QUIT
DO HDR^IVMRNQ1
DO THDR^IVMRNQ1
+12 WRITE !?2,$$FMTE^XLFDT($PIECE(IVMTR0,"^",2))
+13 WRITE ?25,$$EXPAND^IVMUFNC(301.6,.03,$PIECE(IVMTR0,"^",3))
+14 WRITE ?53,$SELECT(IVMTR1:$EXTRACT($PIECE($$MTS^DGMTU("",+IVMTR1),"^"),1,13),1:"UNKNOWN")
+15 WRITE ?67,$SELECT($PIECE(IVMTR1,"^",2):"YES",1:"NO")
+16 IF $PIECE(IVMTR0,"^",4)]""
Begin DoDot:2
+17 IF $Y>(IOSL-3)
DO PAUSE^IVMRUTL
if IVMQUIT
QUIT
DO HDR^IVMRNQ1
DO THDR^IVMRNQ1
+18 WRITE !?4,"Error: ",$EXTRACT($PIECE(IVMTR0,"^",4),1,70)
End DoDot:2
End DoDot:1
if IVMQUIT
GOTO END
+19 ;
+20 ; - list billing history
+21 IF '$ORDER(^IVM(301.61,"C",DFN,0))
GOTO UPL
+22 IF $Y>(IOSL-6)
DO PAUSE^IVMRUTL
if IVMQUIT
GOTO END
DO HDR^IVMRNQ1
+23 DO BHDR^IVMRNQ1
+24 SET IVMTR=0
FOR
SET IVMTR=$ORDER(^IVM(301.61,"C",DFN,IVMTR))
if 'IVMTR
QUIT
Begin DoDot:1
+25 SET IVMTR0=$GET(^IVM(301.61,IVMTR,0))
+26 IF $Y>(IOSL-3)
DO PAUSE^IVMRUTL
if IVMQUIT
QUIT
DO HDR^IVMRNQ1
DO BHDR^IVMRNQ1
+27 WRITE !?2,$$EXPAND^IVMUFNC(301.61,.04,$PIECE(IVMTR0,"^",4))
+28 WRITE ?14,$$DAT1^IVMUFNC4($PIECE(IVMTR0,"^",5))
+29 WRITE ?24,$$DAT1^IVMUFNC4($PIECE(IVMTR0,"^",6))
+30 WRITE ?34,$JUSTIFY($PIECE(IVMTR0,"^",8),8,2)
+31 WRITE ?44,$SELECT($PIECE(IVMTR0,"^",4)>1:" N/A",1:$JUSTIFY($PIECE(IVMTR0,"^",9),8,2))
+32 WRITE ?55,$SELECT($PIECE(IVMTR0,"^",11):"YES",1:"NO")
+33 WRITE ?63,$SELECT($PIECE(IVMTR0,"^",10):"YES",1:"NO")
+34 WRITE ?70,$SELECT($PIECE(IVMTR0,"^",13):$$DAT1^IVMUFNC4($PIECE(IVMTR0,"^",13)),1:"Not Sent")
End DoDot:1
if IVMQUIT
GOTO END
+35 ;
UPL ; - check for upload information
+1 DO CKUPL^IVMRNQ1
IF '$DATA(IVMTXT)
GOTO END1
+2 IF $Y>(IOSL-6)
DO PAUSE^IVMRUTL
if IVMQUIT
GOTO END
DO HDR^IVMRNQ1
+3 ;
+4 WRITE !
+5 FOR IVMS=1,2,3
IF $DATA(IVMTXT(IVMS))
WRITE !,$PIECE($TEXT(UPTXT+IVMS^IVMRNQ1),";;",2)
+6 SET IVMS=0
FOR
SET IVMS=$ORDER(IVMTXT(4,IVMS))
if 'IVMS
QUIT
SET IVMX=IVMTXT(4,IVMS)
Begin DoDot:1
+7 IF $PIECE(IVMX,"^",5)
WRITE !,"Insurance data was uploaded on ",$$DAT1^IVMUFNC4($PIECE(IVMX,"^",5),1),"."
+8 IF $PIECE(IVMX,"^",8)
WRITE !,"Insurance data for this patient was rejected: ",$PIECE($GET(^IVM(301.91,$PIECE(IVMX,"^",8),0)),"^",2)
End DoDot:1
+9 ;
END1 DO PAUSE^IVMRUTL
+1 ;
END IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 DO ^%ZISC
+2 KILL %DT,DFN,IVMYR,IVMDA,IVMPAG,IVMNAM,IVM0,IVM1,IVMDAT,IVMMT,X,Y,ZTSK
+3 KILL IVMTR,IVMTR0,IVMTR1,IVMI,IVMX,DIRUT,DUOUT,DTOUT,IVMS,IVMTXT
+4 QUIT
+5 ;
HLP ; Help to select Income Year.
+1 NEW I
+2 WRITE !!,"Please select one of the following Income Years:",!
+3 SET I=0
FOR
SET I=$ORDER(^IVM(301.5,"APT",DFN,I))
if 'I
QUIT
IF I>2900000
WRITE !?4,$EXTRACT(I,1,3)+1700
+4 QUIT
