- DVBCIUTL ;ALB/GTS-AMIE INSUFFICIENT RPT UTILITY RTN ; 11/14/94 9:15 AM
- ;;2.7;AMIE;**13,17,19,149,184,185,192**;Apr 10, 1995;Build 15
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;** Version Changes
- ; 2.7 - New routine (Enhc 15)
- ;
- DETHD ;** AMIE Detailed Report header
- N DVBAI,DVBATXT S DVBAI=2
- ;I DVBADLMTR="," S:DVBAPRTY'["QS" MSGCNT=1 S:$G(DVBAP)="QS" ^TMP("INSUFF",$J,MSGCNT)=$C(13)_$C(13),MSGCNT=MSGCNT+1 D DETHDLIM Q
- I DVBADLMTR="," D Q
- . S MSGCNT=MSGCNT+1
- . S:$G(DVBAP)="QS" ^TMP("INSUFF",$J,MSGCNT)=$C(13)_$C(13),MSGCNT=MSGCNT+1 D DETHDLIM Q
- . I MSGCNT=1!(MSGCNT=2) D DETHDLIM Q
- S:'$D(DVBAPG1) TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
- S:$D(DVBAPG1) TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
- S DVBATXT=$$PRHD(DVBAPRTY)
- S TVAR(DVBAI,0)="0,"_((63-$L(DVBATXT))\2)_",0,1,0^"_DVBATXT
- S DVBAI=DVBAI+1
- S TVAR(DVBAI,0)="0,11,0,2,0^For Date Range: "_STRTDT_" to "_LSTDT
- D WR^DVBAUTL4("TVAR")
- K TVAR
- Q
- CAPDETHD ;** CAPRI Detailed Report header
- N DVBAI,DVBATXT S DVBAI=2
- I DVBADLMTR="," D Q
- . S MSGCNT=MSGCNT+1
- . I MSGCNT=1!(MSGCNT=2) D DETHDLIM Q
- S:'$D(DVBAPG1) TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
- S:$D(DVBAPG1) TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
- S DVBATXT=""
- S TVAR(DVBAI,0)="0,"_((63-$L(DVBATXT))\2)_",0,0,0^"_DVBATXT
- S DVBAI=DVBAI+1
- S TVAR(DVBAI,0)="0,11,0,1,0^For Date Range: "_STRTDT_" to "_LSTDT
- D WR^DVBAUTL4("TVAR")
- K TVAR
- Q
- ;
- DETHDLIM ;Print Report Header in delimited format
- S ^TMP("INSUFF",$J,MSGCNT)="Detailed Insufficient Exam Report"_$C(13),MSGCNT=MSGCNT+1
- S ^TMP("INSUFF",$J,MSGCNT)="FOR DATE RANGE: "_STRTDT_" TO "_LSTDT_$C(13)_$C(13),MSGCNT=MSGCNT+1
- S ^TMP("INSUFF",$J,MSGCNT)="Reason"_DVBADLMTR_"Exam"_DVBADLMTR_"Provider"_DVBADLMTR_"Exam Date"_DVBADLMTR_"Patient Name"_DVBADLMTR_"SSN"_DVBADLMTR
- S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_"Claim #"_DVBADLMTR_"Claim Type"_DVBADLMTR_"Special Consideration(s)"_DVBADLMTR_"Priority of Exam"_DVBADLMTR
- S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_"Cancellation Information"_DVBADLMTR_"Cancellation Reason"_$C(13),MSGCNT=MSGCNT+1
- Q
- ;
- ;Input : DVBAPRTY - Priority Exam Code (File #396.3 Fld #9)
- ;Output: Description for Priority Exam Code
- PRHD(DVBAPRTY) ;priority exam type header info
- N DVBATXT
- S DVBATXT=$S((DVBAPRTY["BDD"):"Benefits Delivery at Discharge",1:"X")
- S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["QS"):"Quick Start",1:"X")
- S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["IDES"):"Integrated Disability Evaluation System",1:"X")
- S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["AO"):"Agent Orange",1:"Excludes Exam Priorities: AO,BDD,IDES,QS")
- S:(DVBATXT'["Excludes") DVBATXT="Priority of Exam: "_DVBATXT
- Q $G(DVBATXT)
- ;
- EXMOUT ;** Output exam information for reason/type
- I $Y>(IOSL-9) DO
- .I IOST?1"C-".E D TERM^DVBCUTL3
- D
- .I '$D(GETOUT) DO
- ..;D DETHD
- ..D RESOUT
- ..W !
- ..D TYPEOUT
- ..S (DVBARSPT,DVBAXMPT)=""
- I '$D(GETOUT) DO
- .I '$D(DVBARSPT) DO
- ..D RESOUT
- ..S DVBARSPT=""
- .I '$D(DVBAXMPT) DO
- ..W !
- ..D TYPEOUT
- ..S DVBAXMPT=""
- .S (DVBARQDT,DVBAXDT,DVBAXRS)=""
- .S REQDA=$P(^DVB(396.4,XMDA,0),U,2) ;*REQDA of PRIORITY Insuf 2507
- .I $D(^DVB(396.4,XMDA,"CAN")) D
- ..S DVBAXDT=$P(^DVB(396.4,XMDA,"CAN"),U,1),DVBAXRS=$P(^("CAN"),U,3)
- ..I DVBAXDT S DVBAXDT=$$FMTE^XLFDT(DVBAXDT,"5DZ")
- ..I DVBAXRS S DVBAXRS=$P(^DVB(396.5,DVBAXRS,0),U,1)
- .I +REQDA>0 DO ;*Get REQDA of Orig 2507
- ..S DFN=$P(^DVB(396.3,REQDA,0),U,1),DVBARQDT=$P(^(0),U,2),DVBARQDT=$$FMTE^XLFDT(DVBARQDT,"5DZ")
- ..I '$D(^DVB(396.3,REQDA,5)) S REQDA=""
- ..I +REQDA>0,($D(^DVB(396.3,REQDA,5))) S REQDA=$P(^DVB(396.3,REQDA,5),U,1)
- .S DVBAORXM=""
- .I +REQDA>0 DO ;*If link to orig 2507
- ..S DVBAXMTP=$P(^DVB(396.4,XMDA,0),U,3)
- ..S DVBACMND="F S DVBAORXM=$O(^DVB(396.4,""ARQ"_REQDA_""","_DVBAXMTP_",DVBAORXM)) Q:DVBAORXM="""" Q:$D(^DVB(396.4,""APS"","_DFN_","_DVBAXMTP_",""C"",DVBAORXM))"
- ..X DVBACMND ;**Return DA of original, insuff exam
- .S DVBANAME=$P(^DPT(DFN,0),U,1)
- .D DEM^VADPT I $G(VADM(1))'="" S DVBASSN=$S(DVBADLMTR=",":$P($G(VADM(2)),U,2),1:$P($G(VADM(2)),U,1))
- .S DVBACNUM="" S:$D(^DPT(DFN,.31)) DVBACNUM=$P(^DPT(DFN,.31),U,3)
- .I DVBAORXM'="",($D(^DVB(396.4,DVBAORXM,0))) S DVBAORDT=$P(^DVB(396.4,DVBAORXM,0),U,6)
- .I DVBAORXM'="",('$D(^DVB(396.4,DVBAORXM,0))) S (DVBAORDT,DVBADTE)=""
- .S:DVBAORXM="" (DVBAORDT,DVBADTE)=""
- .S:DVBAORDT="" DVBADTE=""
- .I DVBAORDT'="" DO
- ..S DVBADTWK=$P(DVBAORDT,".",1)
- ..S DVBADTE=$$FMTE^XLFDT(DVBADTWK,"5DZ")
- .S DVBAORPV=$P(^DVB(396.4,XMDA,0),U,12)
- .S DVBABIEN=$P(^DVB(396.4,XMDA,0),U,2)
- .D CLAIMTYP,SPEC,PRIORITY
- .I DVBADLMTR="," D DETDELIM D:DVBAXDT]"" DETITEMS S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_$C(13),MSGCNT=MSGCNT+1 Q
- .S DVBAORP1=$E(DVBAORPV,1,15)
- .S DVBANAM1=$E(DVBANAME,1,15)
- .W !,DVBAORP1
- .W:$L(DVBAORPV)>$L(DVBAORP1) "**" ;**Indicate that Dr.'s Name truncated
- .W ?20,DVBADTE,?32,DVBANAM1
- .W:$L(DVBANAME)>$L(DVBANAM1) "**" ;**Indicate that Vet's Name truncated
- .W ?52,DVBASSN,?66,DVBACNUM
- .W !,?2,"Claim Type: "_DVBCTW,!,?2,"Special Consideration(s): "_DVBSCWA,!,?2,"Priority Of Exam: "_DVBPOX
- .I DVBAXDT]"" D
- ..W !,"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
- ..W !,"Reason: "_DVBAXRS_"."
- K DVBAA,DVBABIEN,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,DVBPOX,DVBPOXID
- Q
- ;
- DETDELIM ; Print details of Insufficient Exams
- ; Reason,Exam,Provider,Exam Date,Patient Name,SSN,Claim #,Claim Type,Special Consideration(s),Priority of Exam
- I $D(^TMP("INSUFF",$J,MSGCNT)) D
- .S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR
- .S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_$C(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_"" Q
- I '$D(^TMP("INSUFF",$J,MSGCNT)) D
- .S ^TMP("INSUFF",$J,MSGCNT)=DVBADLMTR_DVBADLMTR_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR_$C(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_""
- Q
- ;
- DETITEMS ; Print final exam details
- S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_DVBADLMTR_"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
- S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_DVBADLMTR_DVBAXRS_"."
- Q
- ;
- RESOUT ;** Output the Reason
- I DVBADLMTR="," S ^TMP("INSUFF",$J,MSGCNT)=$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)_DVBADLMTR Q
- W !!!!!,"Reason: ",$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)
- Q
- ;
- TYPEOUT ;** Output the Exam
- I DVBADLMTR="," D TYPEDLIM Q
- W !,"Exam: ",$P(^DVB(396.6,$P(^DVB(396.4,XMDA,0),U,3),0),U,2)
- W !,"Provider",?20,"Exam Dt",?32,"Patient Name",?52,"SSN",?66,"Claim #"
- Q
- ;
- TYPEDLIM ; ** Output the delimited Exam
- I $D(^TMP("INSUFF",$J,MSGCNT)) S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_""""_$P(^DVB(396.6,$P(^DVB(396.4,XMDA,0),U,3),0),U,2)_""""_DVBADLMTR Q
- I '$D(^TMP("INSUFF",$J,MSGCNT)) S ^TMP("INSUFF",$J,MSGCNT)=$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)_DVBADLMTR_""""_$P(^DVB(396.6,$P(^DVB(396.4,XMDA,0),U,3),0),U,2)_""""_DVBADLMTR Q
- ;
- RSEL ;** Select Reasons
- ;** The selection prompt is defaulted to ALL. If the user selects
- ;** 'All', only reasons for exams entered on requests with a
- ;** priority of 'Insufficient' will be reported. Not all reasons.
- ;
- W @IOF,!
- W !,"Insufficient Reason Selection"
- S DVBCYQ=""
- N RESANS,DVBAOUT S DVBAOUT="" ;**Pre-read
- K Y,DTOUT,DUOUT,DVBATSAV
- F Q:(DVBAOUT=1!(DVBCYQ=1)) DO
- .W !!," Enter '^' to end Reason Selection"
- .W !," 'Return' to select all Insufficient Reasons",!
- .K DIC,DTOUT,DUOUT,Y
- .W !," Enter Insufficient Reason: ALL//"
- .R RESANS:DTIME
- .S:$T DVBATSAV=""
- .I RESANS=""&($D(DVBATSAV)) S Y=-1 D INREAS^DVBCIUT1
- .S:('$D(DVBATSAV)!(RESANS["^")) DVBAOUT="1"
- .I DVBAOUT'=1,('$D(Y)) DO
- ..I RESANS["?" DO
- ...N LPDA S LPDA=0
- ...W !,"CHOOSE FROM:"
- ...F S LPDA=$O(^DVB(396.94,LPDA)) Q:+LPDA'>0 DO
- ....W !,?3,$P(^DVB(396.94,LPDA,0),U,1)
- ...W !
- ..I RESANS'["?" DO
- ...S DIC="^DVB(396.94,"
- ...S DIC(0)="EMQ"
- ...S X=RESANS
- ...D ^DIC
- ...D:+Y>0 INREAS^DVBCIUT1
- .I RESANS="",($D(Y)&(+Y=-1)) S DVBCYQ=1
- K DTOUT,DUOUT,Y,DIC,DVBCYQ,DVBATSAV
- Q
- ;
- XMSEL ;** Select Exams
- ;** The selection prompt is defaulted to ALL. If the user selects
- ;** 'All', only exams entered on requests with a priority of
- ;** 'Insufficient' will be reported. Not all exams.
- ;
- W @IOF,!
- W !,"AMIE Exam Selection"
- S DVBCYQ=""
- K Y,DTOUT,DUOUT
- F Q:($D(DTOUT)!($D(DUOUT)!(DVBCYQ=1))) DO
- .W !!," Enter '^' to end Exam Selection"
- .W !," 'Return' to select all AMIE Exams",!
- .K DIC,DTOUT,DUOUT
- .S DIC="^DVB(396.6,"
- .S DIC(0)="AEMQ"
- .S DIC("A")=" Enter Exam: ALL//"
- .;removed screen for inactive exams
- .D ^DIC
- .I '$D(DTOUT),('$D(DUOUT)) D EXMTPE^DVBCIUT1
- .I $D(Y),(+Y=-1) S DVBCYQ=1
- K DTOUT,DUOUT,Y,DIC,DVBCYQ
- Q
- ;
- ;Input: DVBADIRA - Prompt to display for DIR call
- ;Ouput: Code selected from set or ^ if user exited selection
- EXMPRTY(DVBADIRA) ;** Select Priority of Exam
- N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- S DIR(0)="S^AO:Agent Orange;BDD:Benefits Delivery at Discharge / Quick Start;"
- S DIR(0)=DIR(0)_"IDES:Integrated Disability Evaluation System;"
- S DIR(0)=DIR(0)_"ALL:All Others"
- S DIR("A")=$S($G(DVBADIRA)]"":DVBADIRA,1:"Select Priority of Exam for the Report")
- S DIR("B")="All Others"
- S DIR("T")=DTIME ;time-out value specified by system
- S DIR("?",1)="Select the priority of exam(s) to report on or ALL for the original report,"
- S DIR("?")="which excludes the AO, BDD and IDES exam priorities."
- D ^DIR
- Q Y
- CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
- S DVBCTW=""
- Q:'$D(^DVB(396.3,DVBABIEN,9,0))
- ;DVBIEN is the 2507 REQUEST FILE IEN
- ;DVBCTW is the string /name of the CLAIM TYPE
- D GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
- S DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
- Q
- SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
- K DVBSCW
- S DVBSCWA=""
- Q:'$D(^DVB(396.3,DVBABIEN,8))
- ;DVBABIEN is the 2507 REQUEST FILE IEN
- ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
- ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
- ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
- S DVBAA=$P(^DVB(396.3,DVBABIEN,8,0),U,4)
- S (DVBSC,DVBCNT)=0 F S DVBSC=$O(^DVB(396.3,DVBABIEN,8,DVBSC)) Q:'DVBSC D
- .S DVBSCN=$P(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
- .S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
- .S DVBCNT=DVBCNT+1
- .I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
- S DVBX="" F S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
- Q
- PRIORITY ;
- S DVBPOX=""
- Q:($P(^DVB(396.3,DVBABIEN,0),U,10))=""
- S DVBPOXID=$P(^DVB(396.3,DVBABIEN,0),U,10)
- S DVBPOX=$$GET1^DIQ(396.3,DVBABIEN,"PRIORITY OF EXAM")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCIUTL 10996 printed Feb 18, 2025@23:11 Page 2
- DVBCIUTL ;ALB/GTS-AMIE INSUFFICIENT RPT UTILITY RTN ; 11/14/94 9:15 AM
- +1 ;;2.7;AMIE;**13,17,19,149,184,185,192**;Apr 10, 1995;Build 15
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;** Version Changes
- +5 ; 2.7 - New routine (Enhc 15)
- +6 ;
- DETHD ;** AMIE Detailed Report header
- +1 NEW DVBAI,DVBATXT
- SET DVBAI=2
- +2 ;I DVBADLMTR="," S:DVBAPRTY'["QS" MSGCNT=1 S:$G(DVBAP)="QS" ^TMP("INSUFF",$J,MSGCNT)=$C(13)_$C(13),MSGCNT=MSGCNT+1 D DETHDLIM Q
- +3 IF DVBADLMTR=","
- Begin DoDot:1
- +4 SET MSGCNT=MSGCNT+1
- +5 if $GET(DVBAP)="QS"
- SET ^TMP("INSUFF",$JOB,MSGCNT)=$CHAR(13)_$CHAR(13)
- SET MSGCNT=MSGCNT+1
- DO DETHDLIM
- QUIT
- +6 IF MSGCNT=1!(MSGCNT=2)
- DO DETHDLIM
- QUIT
- End DoDot:1
- QUIT
- +7 if '$DATA(DVBAPG1)
- SET TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
- +8 if $DATA(DVBAPG1)
- SET TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
- +9 SET DVBATXT=$$PRHD(DVBAPRTY)
- +10 SET TVAR(DVBAI,0)="0,"_((63-$LENGTH(DVBATXT))\2)_",0,1,0^"_DVBATXT
- +11 SET DVBAI=DVBAI+1
- +12 SET TVAR(DVBAI,0)="0,11,0,2,0^For Date Range: "_STRTDT_" to "_LSTDT
- +13 DO WR^DVBAUTL4("TVAR")
- +14 KILL TVAR
- +15 QUIT
- CAPDETHD ;** CAPRI Detailed Report header
- +1 NEW DVBAI,DVBATXT
- SET DVBAI=2
- +2 IF DVBADLMTR=","
- Begin DoDot:1
- +3 SET MSGCNT=MSGCNT+1
- +4 IF MSGCNT=1!(MSGCNT=2)
- DO DETHDLIM
- QUIT
- End DoDot:1
- QUIT
- +5 if '$DATA(DVBAPG1)
- SET TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
- +6 if $DATA(DVBAPG1)
- SET TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
- +7 SET DVBATXT=""
- +8 SET TVAR(DVBAI,0)="0,"_((63-$LENGTH(DVBATXT))\2)_",0,0,0^"_DVBATXT
- +9 SET DVBAI=DVBAI+1
- +10 SET TVAR(DVBAI,0)="0,11,0,1,0^For Date Range: "_STRTDT_" to "_LSTDT
- +11 DO WR^DVBAUTL4("TVAR")
- +12 KILL TVAR
- +13 QUIT
- +14 ;
- DETHDLIM ;Print Report Header in delimited format
- +1 SET ^TMP("INSUFF",$JOB,MSGCNT)="Detailed Insufficient Exam Report"_$CHAR(13)
- SET MSGCNT=MSGCNT+1
- +2 SET ^TMP("INSUFF",$JOB,MSGCNT)="FOR DATE RANGE: "_STRTDT_" TO "_LSTDT_$CHAR(13)_$CHAR(13)
- SET MSGCNT=MSGCNT+1
- +3 SET ^TMP("INSUFF",$JOB,MSGCNT)="Reason"_DVBADLMTR_"Exam"_DVBADLMTR_"Provider"_DVBADLMTR_"Exam Date"_DVBADLMTR_"Patient Name"_DVBADLMTR_"SSN"_DVBADLMTR
- +4 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_"Claim #"_DVBADLMTR_"Claim Type"_DVBADLMTR_"Special Consideration(s)"_DVBADLMTR_"Priority of Exam"_DVBADLMTR
- +5 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_"Cancellation Information"_DVBADLMTR_"Cancellation Reason"_$CHAR(13)
- SET MSGCNT=MSGCNT+1
- +6 QUIT
- +7 ;
- +8 ;Input : DVBAPRTY - Priority Exam Code (File #396.3 Fld #9)
- +9 ;Output: Description for Priority Exam Code
- PRHD(DVBAPRTY) ;priority exam type header info
- +1 NEW DVBATXT
- +2 SET DVBATXT=$SELECT((DVBAPRTY["BDD"):"Benefits Delivery at Discharge",1:"X")
- +3 if (DVBATXT="X")
- SET DVBATXT=$SELECT((DVBAPRTY["QS"):"Quick Start",1:"X")
- +4 if (DVBATXT="X")
- SET DVBATXT=$SELECT((DVBAPRTY["IDES"):"Integrated Disability Evaluation System",1:"X")
- +5 if (DVBATXT="X")
- SET DVBATXT=$SELECT((DVBAPRTY["AO"):"Agent Orange",1:"Excludes Exam Priorities: AO,BDD,IDES,QS")
- +6 if (DVBATXT'["Excludes")
- SET DVBATXT="Priority of Exam: "_DVBATXT
- +7 QUIT $GET(DVBATXT)
- +8 ;
- EXMOUT ;** Output exam information for reason/type
- +1 IF $Y>(IOSL-9)
- Begin DoDot:1
- +2 IF IOST?1"C-".E
- DO TERM^DVBCUTL3
- End DoDot:1
- +3 Begin DoDot:1
- +4 IF '$DATA(GETOUT)
- Begin DoDot:2
- +5 ;D DETHD
- +6 DO RESOUT
- +7 WRITE !
- +8 DO TYPEOUT
- +9 SET (DVBARSPT,DVBAXMPT)=""
- End DoDot:2
- End DoDot:1
- +10 IF '$DATA(GETOUT)
- Begin DoDot:1
- +11 IF '$DATA(DVBARSPT)
- Begin DoDot:2
- +12 DO RESOUT
- +13 SET DVBARSPT=""
- End DoDot:2
- +14 IF '$DATA(DVBAXMPT)
- Begin DoDot:2
- +15 WRITE !
- +16 DO TYPEOUT
- +17 SET DVBAXMPT=""
- End DoDot:2
- +18 SET (DVBARQDT,DVBAXDT,DVBAXRS)=""
- +19 ;*REQDA of PRIORITY Insuf 2507
- SET REQDA=$PIECE(^DVB(396.4,XMDA,0),U,2)
- +20 IF $DATA(^DVB(396.4,XMDA,"CAN"))
- Begin DoDot:2
- +21 SET DVBAXDT=$PIECE(^DVB(396.4,XMDA,"CAN"),U,1)
- SET DVBAXRS=$PIECE(^("CAN"),U,3)
- +22 IF DVBAXDT
- SET DVBAXDT=$$FMTE^XLFDT(DVBAXDT,"5DZ")
- +23 IF DVBAXRS
- SET DVBAXRS=$PIECE(^DVB(396.5,DVBAXRS,0),U,1)
- End DoDot:2
- +24 ;*Get REQDA of Orig 2507
- IF +REQDA>0
- Begin DoDot:2
- +25 SET DFN=$PIECE(^DVB(396.3,REQDA,0),U,1)
- SET DVBARQDT=$PIECE(^(0),U,2)
- SET DVBARQDT=$$FMTE^XLFDT(DVBARQDT,"5DZ")
- +26 IF '$DATA(^DVB(396.3,REQDA,5))
- SET REQDA=""
- +27 IF +REQDA>0
- IF ($DATA(^DVB(396.3,REQDA,5)))
- SET REQDA=$PIECE(^DVB(396.3,REQDA,5),U,1)
- End DoDot:2
- +28 SET DVBAORXM=""
- +29 ;*If link to orig 2507
- IF +REQDA>0
- Begin DoDot:2
- +30 SET DVBAXMTP=$PIECE(^DVB(396.4,XMDA,0),U,3)
- +31 SET DVBACMND="F S DVBAORXM=$O(^DVB(396.4,""ARQ"_REQDA_""","_DVBAXMTP_",DVBAORXM)) Q:DVBAORXM="""" Q:$D(^DVB(396.4,""APS"","_DFN_","_DVBAXMTP_",""C"",DVBAORXM))"
- +32 ;**Return DA of original, insuff exam
- XECUTE DVBACMND
- End DoDot:2
- +33 SET DVBANAME=$PIECE(^DPT(DFN,0),U,1)
- +34 DO DEM^VADPT
- IF $GET(VADM(1))'=""
- SET DVBASSN=$SELECT(DVBADLMTR=",":$PIECE($GET(VADM(2)),U,2),1:$PIECE($GET(VADM(2)),U,1))
- +35 SET DVBACNUM=""
- if $DATA(^DPT(DFN,.31))
- SET DVBACNUM=$PIECE(^DPT(DFN,.31),U,3)
- +36 IF DVBAORXM'=""
- IF ($DATA(^DVB(396.4,DVBAORXM,0)))
- SET DVBAORDT=$PIECE(^DVB(396.4,DVBAORXM,0),U,6)
- +37 IF DVBAORXM'=""
- IF ('$DATA(^DVB(396.4,DVBAORXM,0)))
- SET (DVBAORDT,DVBADTE)=""
- +38 if DVBAORXM=""
- SET (DVBAORDT,DVBADTE)=""
- +39 if DVBAORDT=""
- SET DVBADTE=""
- +40 IF DVBAORDT'=""
- Begin DoDot:2
- +41 SET DVBADTWK=$PIECE(DVBAORDT,".",1)
- +42 SET DVBADTE=$$FMTE^XLFDT(DVBADTWK,"5DZ")
- End DoDot:2
- +43 SET DVBAORPV=$PIECE(^DVB(396.4,XMDA,0),U,12)
- +44 SET DVBABIEN=$PIECE(^DVB(396.4,XMDA,0),U,2)
- +45 DO CLAIMTYP
- DO SPEC
- DO PRIORITY
- +46 IF DVBADLMTR=","
- DO DETDELIM
- if DVBAXDT]""
- DO DETITEMS
- SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_$CHAR(13)
- SET MSGCNT=MSGCNT+1
- QUIT
- +47 SET DVBAORP1=$EXTRACT(DVBAORPV,1,15)
- +48 SET DVBANAM1=$EXTRACT(DVBANAME,1,15)
- +49 WRITE !,DVBAORP1
- +50 ;**Indicate that Dr.'s Name truncated
- if $LENGTH(DVBAORPV)>$LENGTH(DVBAORP1)
- WRITE "**"
- +51 WRITE ?20,DVBADTE,?32,DVBANAM1
- +52 ;**Indicate that Vet's Name truncated
- if $LENGTH(DVBANAME)>$LENGTH(DVBANAM1)
- WRITE "**"
- +53 WRITE ?52,DVBASSN,?66,DVBACNUM
- +54 WRITE !,?2,"Claim Type: "_DVBCTW,!,?2,"Special Consideration(s): "_DVBSCWA,!,?2,"Priority Of Exam: "_DVBPOX
- +55 IF DVBAXDT]""
- Begin DoDot:2
- +56 WRITE !,"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
- +57 WRITE !,"Reason: "_DVBAXRS_"."
- End DoDot:2
- End DoDot:1
- +58 KILL DVBAA,DVBABIEN,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,DVBPOX,DVBPOXID
- +59 QUIT
- +60 ;
- DETDELIM ; Print details of Insufficient Exams
- +1 ; Reason,Exam,Provider,Exam Date,Patient Name,SSN,Claim #,Claim Type,Special Consideration(s),Priority of Exam
- +2 IF $DATA(^TMP("INSUFF",$JOB,MSGCNT))
- Begin DoDot:1
- +3 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR
- +4 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_$CHAR(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_""
- QUIT
- End DoDot:1
- +5 IF '$DATA(^TMP("INSUFF",$JOB,MSGCNT))
- Begin DoDot:1
- +6 SET ^TMP("INSUFF",$JOB,MSGCNT)=DVBADLMTR_DVBADLMTR_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR_$CHAR(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_""
- End DoDot:1
- +7 QUIT
- +8 ;
- DETITEMS ; Print final exam details
- +1 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_DVBADLMTR_"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
- +2 SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_DVBADLMTR_DVBAXRS_"."
- +3 QUIT
- +4 ;
- RESOUT ;** Output the Reason
- +1 IF DVBADLMTR=","
- SET ^TMP("INSUFF",$JOB,MSGCNT)=$PIECE(^DVB(396.94,$PIECE(^DVB(396.4,XMDA,0),U,11),0),U,3)_DVBADLMTR
- QUIT
- +2 WRITE !!!!!,"Reason: ",$PIECE(^DVB(396.94,$PIECE(^DVB(396.4,XMDA,0),U,11),0),U,3)
- +3 QUIT
- +4 ;
- TYPEOUT ;** Output the Exam
- +1 IF DVBADLMTR=","
- DO TYPEDLIM
- QUIT
- +2 WRITE !,"Exam: ",$PIECE(^DVB(396.6,$PIECE(^DVB(396.4,XMDA,0),U,3),0),U,2)
- +3 WRITE !,"Provider",?20,"Exam Dt",?32,"Patient Name",?52,"SSN",?66,"Claim #"
- +4 QUIT
- +5 ;
- TYPEDLIM ; ** Output the delimited Exam
- +1 IF $DATA(^TMP("INSUFF",$JOB,MSGCNT))
- SET ^TMP("INSUFF",$JOB,MSGCNT)=^TMP("INSUFF",$JOB,MSGCNT)_""""_$PIECE(^DVB(396.6,$PIECE(^DVB(396.4,XMDA,0),U,3),0),U,2)_""""_DVBADLMTR
- QUIT
- +2 IF '$DATA(^TMP("INSUFF",$JOB,MSGCNT))
- SET ^TMP("INSUFF",$JOB,MSGCNT)=$PIECE(^DVB(396.94,$PIECE(^DVB(396.4,XMDA,0),U,11),0),U,3)_DVBADLMTR_""""_$PIECE(^DVB(396.6,$PIECE(^DVB(396.4,XMDA,0),U,3),0),U,2)_""""_DVBADLMTR
- QUIT
- +3 ;
- RSEL ;** Select Reasons
- +1 ;** The selection prompt is defaulted to ALL. If the user selects
- +2 ;** 'All', only reasons for exams entered on requests with a
- +3 ;** priority of 'Insufficient' will be reported. Not all reasons.
- +4 ;
- +5 WRITE @IOF,!
- +6 WRITE !,"Insufficient Reason Selection"
- +7 SET DVBCYQ=""
- +8 ;**Pre-read
- NEW RESANS,DVBAOUT
- SET DVBAOUT=""
- +9 KILL Y,DTOUT,DUOUT,DVBATSAV
- +10 FOR
- if (DVBAOUT=1!(DVBCYQ=1))
- QUIT
- Begin DoDot:1
- +11 WRITE !!," Enter '^' to end Reason Selection"
- +12 WRITE !," 'Return' to select all Insufficient Reasons",!
- +13 KILL DIC,DTOUT,DUOUT,Y
- +14 WRITE !," Enter Insufficient Reason: ALL//"
- +15 READ RESANS:DTIME
- +16 if $TEST
- SET DVBATSAV=""
- +17 IF RESANS=""&($DATA(DVBATSAV))
- SET Y=-1
- DO INREAS^DVBCIUT1
- +18 if ('$DATA(DVBATSAV)!(RESANS["^"))
- SET DVBAOUT="1"
- +19 IF DVBAOUT'=1
- IF ('$DATA(Y))
- Begin DoDot:2
- +20 IF RESANS["?"
- Begin DoDot:3
- +21 NEW LPDA
- SET LPDA=0
- +22 WRITE !,"CHOOSE FROM:"
- +23 FOR
- SET LPDA=$ORDER(^DVB(396.94,LPDA))
- if +LPDA'>0
- QUIT
- Begin DoDot:4
- +24 WRITE !,?3,$PIECE(^DVB(396.94,LPDA,0),U,1)
- End DoDot:4
- +25 WRITE !
- End DoDot:3
- +26 IF RESANS'["?"
- Begin DoDot:3
- +27 SET DIC="^DVB(396.94,"
- +28 SET DIC(0)="EMQ"
- +29 SET X=RESANS
- +30 DO ^DIC
- +31 if +Y>0
- DO INREAS^DVBCIUT1
- End DoDot:3
- End DoDot:2
- +32 IF RESANS=""
- IF ($DATA(Y)&(+Y=-1))
- SET DVBCYQ=1
- End DoDot:1
- +33 KILL DTOUT,DUOUT,Y,DIC,DVBCYQ,DVBATSAV
- +34 QUIT
- +35 ;
- XMSEL ;** Select Exams
- +1 ;** The selection prompt is defaulted to ALL. If the user selects
- +2 ;** 'All', only exams entered on requests with a priority of
- +3 ;** 'Insufficient' will be reported. Not all exams.
- +4 ;
- +5 WRITE @IOF,!
- +6 WRITE !,"AMIE Exam Selection"
- +7 SET DVBCYQ=""
- +8 KILL Y,DTOUT,DUOUT
- +9 FOR
- if ($DATA(DTOUT)!($DATA(DUOUT)!(DVBCYQ=1)))
- QUIT
- Begin DoDot:1
- +10 WRITE !!," Enter '^' to end Exam Selection"
- +11 WRITE !," 'Return' to select all AMIE Exams",!
- +12 KILL DIC,DTOUT,DUOUT
- +13 SET DIC="^DVB(396.6,"
- +14 SET DIC(0)="AEMQ"
- +15 SET DIC("A")=" Enter Exam: ALL//"
- +16 ;removed screen for inactive exams
- +17 DO ^DIC
- +18 IF '$DATA(DTOUT)
- IF ('$DATA(DUOUT))
- DO EXMTPE^DVBCIUT1
- +19 IF $DATA(Y)
- IF (+Y=-1)
- SET DVBCYQ=1
- End DoDot:1
- +20 KILL DTOUT,DUOUT,Y,DIC,DVBCYQ
- +21 QUIT
- +22 ;
- +23 ;Input: DVBADIRA - Prompt to display for DIR call
- +24 ;Ouput: Code selected from set or ^ if user exited selection
- EXMPRTY(DVBADIRA) ;** Select Priority of Exam
- +1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +2 SET DIR(0)="S^AO:Agent Orange;BDD:Benefits Delivery at Discharge / Quick Start;"
- +3 SET DIR(0)=DIR(0)_"IDES:Integrated Disability Evaluation System;"
- +4 SET DIR(0)=DIR(0)_"ALL:All Others"
- +5 SET DIR("A")=$SELECT($GET(DVBADIRA)]"":DVBADIRA,1:"Select Priority of Exam for the Report")
- +6 SET DIR("B")="All Others"
- +7 ;time-out value specified by system
- SET DIR("T")=DTIME
- +8 SET DIR("?",1)="Select the priority of exam(s) to report on or ALL for the original report,"
- +9 SET DIR("?")="which excludes the AO, BDD and IDES exam priorities."
- +10 DO ^DIR
- +11 QUIT Y
- CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
- +1 SET DVBCTW=""
- +2 if '$DATA(^DVB(396.3,DVBABIEN,9,0))
- QUIT
- +3 ;DVBIEN is the 2507 REQUEST FILE IEN
- +4 ;DVBCTW is the string /name of the CLAIM TYPE
- +5 DO GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
- +6 SET DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
- +7 QUIT
- SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
- +1 KILL DVBSCW
- +2 SET DVBSCWA=""
- +3 if '$DATA(^DVB(396.3,DVBABIEN,8))
- QUIT
- +4 ;DVBABIEN is the 2507 REQUEST FILE IEN
- +5 ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
- +6 ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
- +7 ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
- +8 SET DVBAA=$PIECE(^DVB(396.3,DVBABIEN,8,0),U,4)
- +9 SET (DVBSC,DVBCNT)=0
- FOR
- SET DVBSC=$ORDER(^DVB(396.3,DVBABIEN,8,DVBSC))
- if 'DVBSC
- QUIT
- Begin DoDot:1
- +10 SET DVBSCN=$PIECE(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
- +11 SET DVBSCW(DVBSC)=$GET(^DVB(396.25,DVBSCN,0))
- +12 SET DVBCNT=DVBCNT+1
- +13 IF (DVBCNT'=DVBAA)
- if $DATA(DVBSCW(DVBSC))
- SET DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
- End DoDot:1
- +14 SET DVBX=""
- FOR
- SET DVBX=$ORDER(DVBSCW(DVBX))
- if 'DVBX
- QUIT
- SET DVBSCWA=DVBSCWA_DVBSCW(DVBX)
- +15 QUIT
- PRIORITY ;
- +1 SET DVBPOX=""
- +2 if ($PIECE(^DVB(396.3,DVBABIEN,0),U,10))=""
- QUIT
- +3 SET DVBPOXID=$PIECE(^DVB(396.3,DVBABIEN,0),U,10)
- +4 SET DVBPOX=$$GET1^DIQ(396.3,DVBABIEN,"PRIORITY OF EXAM")
- +5 QUIT