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