Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DVBCIUTL

DVBCIUTL.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;** Version Changes
  1. ; 2.7 - New routine (Enhc 15)
  1. ;
  1. DETHD ;** AMIE Detailed Report header
  1. N DVBAI,DVBATXT S DVBAI=2
  1. ;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
  1. I DVBADLMTR="," D Q
  1. . S MSGCNT=MSGCNT+1
  1. . S:$G(DVBAP)="QS" ^TMP("INSUFF",$J,MSGCNT)=$C(13)_$C(13),MSGCNT=MSGCNT+1 D DETHDLIM Q
  1. . I MSGCNT=1!(MSGCNT=2) D DETHDLIM Q
  1. S:'$D(DVBAPG1) TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
  1. S:$D(DVBAPG1) TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
  1. S DVBATXT=$$PRHD(DVBAPRTY)
  1. S TVAR(DVBAI,0)="0,"_((63-$L(DVBATXT))\2)_",0,1,0^"_DVBATXT
  1. S DVBAI=DVBAI+1
  1. S TVAR(DVBAI,0)="0,11,0,2,0^For Date Range: "_STRTDT_" to "_LSTDT
  1. D WR^DVBAUTL4("TVAR")
  1. K TVAR
  1. Q
  1. CAPDETHD ;** CAPRI Detailed Report header
  1. N DVBAI,DVBATXT S DVBAI=2
  1. I DVBADLMTR="," D Q
  1. . S MSGCNT=MSGCNT+1
  1. . I MSGCNT=1!(MSGCNT=2) D DETHDLIM Q
  1. S:'$D(DVBAPG1) TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
  1. S:$D(DVBAPG1) TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
  1. S DVBATXT=""
  1. S TVAR(DVBAI,0)="0,"_((63-$L(DVBATXT))\2)_",0,0,0^"_DVBATXT
  1. S DVBAI=DVBAI+1
  1. S TVAR(DVBAI,0)="0,11,0,1,0^For Date Range: "_STRTDT_" to "_LSTDT
  1. D WR^DVBAUTL4("TVAR")
  1. K TVAR
  1. Q
  1. ;
  1. DETHDLIM ;Print Report Header in delimited format
  1. S ^TMP("INSUFF",$J,MSGCNT)="Detailed Insufficient Exam Report"_$C(13),MSGCNT=MSGCNT+1
  1. S ^TMP("INSUFF",$J,MSGCNT)="FOR DATE RANGE: "_STRTDT_" TO "_LSTDT_$C(13)_$C(13),MSGCNT=MSGCNT+1
  1. S ^TMP("INSUFF",$J,MSGCNT)="Reason"_DVBADLMTR_"Exam"_DVBADLMTR_"Provider"_DVBADLMTR_"Exam Date"_DVBADLMTR_"Patient Name"_DVBADLMTR_"SSN"_DVBADLMTR
  1. S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_"Claim #"_DVBADLMTR_"Claim Type"_DVBADLMTR_"Special Consideration(s)"_DVBADLMTR_"Priority of Exam"_DVBADLMTR
  1. S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_"Cancellation Information"_DVBADLMTR_"Cancellation Reason"_$C(13),MSGCNT=MSGCNT+1
  1. Q
  1. ;
  1. ;Input : DVBAPRTY - Priority Exam Code (File #396.3 Fld #9)
  1. ;Output: Description for Priority Exam Code
  1. PRHD(DVBAPRTY) ;priority exam type header info
  1. N DVBATXT
  1. S DVBATXT=$S((DVBAPRTY["BDD"):"Benefits Delivery at Discharge",1:"X")
  1. S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["QS"):"Quick Start",1:"X")
  1. S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["IDES"):"Integrated Disability Evaluation System",1:"X")
  1. S:(DVBATXT="X") DVBATXT=$S((DVBAPRTY["AO"):"Agent Orange",1:"Excludes Exam Priorities: AO,BDD,IDES,QS")
  1. S:(DVBATXT'["Excludes") DVBATXT="Priority of Exam: "_DVBATXT
  1. Q $G(DVBATXT)
  1. ;
  1. EXMOUT ;** Output exam information for reason/type
  1. I $Y>(IOSL-9) DO
  1. .I IOST?1"C-".E D TERM^DVBCUTL3
  1. D
  1. .I '$D(GETOUT) DO
  1. ..;D DETHD
  1. ..D RESOUT
  1. ..W !
  1. ..D TYPEOUT
  1. ..S (DVBARSPT,DVBAXMPT)=""
  1. I '$D(GETOUT) DO
  1. .I '$D(DVBARSPT) DO
  1. ..D RESOUT
  1. ..S DVBARSPT=""
  1. .I '$D(DVBAXMPT) DO
  1. ..W !
  1. ..D TYPEOUT
  1. ..S DVBAXMPT=""
  1. .S (DVBARQDT,DVBAXDT,DVBAXRS)=""
  1. .S REQDA=$P(^DVB(396.4,XMDA,0),U,2) ;*REQDA of PRIORITY Insuf 2507
  1. .I $D(^DVB(396.4,XMDA,"CAN")) D
  1. ..S DVBAXDT=$P(^DVB(396.4,XMDA,"CAN"),U,1),DVBAXRS=$P(^("CAN"),U,3)
  1. ..I DVBAXDT S DVBAXDT=$$FMTE^XLFDT(DVBAXDT,"5DZ")
  1. ..I DVBAXRS S DVBAXRS=$P(^DVB(396.5,DVBAXRS,0),U,1)
  1. .I +REQDA>0 DO ;*Get REQDA of Orig 2507
  1. ..S DFN=$P(^DVB(396.3,REQDA,0),U,1),DVBARQDT=$P(^(0),U,2),DVBARQDT=$$FMTE^XLFDT(DVBARQDT,"5DZ")
  1. ..I '$D(^DVB(396.3,REQDA,5)) S REQDA=""
  1. ..I +REQDA>0,($D(^DVB(396.3,REQDA,5))) S REQDA=$P(^DVB(396.3,REQDA,5),U,1)
  1. .S DVBAORXM=""
  1. .I +REQDA>0 DO ;*If link to orig 2507
  1. ..S DVBAXMTP=$P(^DVB(396.4,XMDA,0),U,3)
  1. ..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))"
  1. ..X DVBACMND ;**Return DA of original, insuff exam
  1. .S DVBANAME=$P(^DPT(DFN,0),U,1)
  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))
  1. .S DVBACNUM="" S:$D(^DPT(DFN,.31)) DVBACNUM=$P(^DPT(DFN,.31),U,3)
  1. .I DVBAORXM'="",($D(^DVB(396.4,DVBAORXM,0))) S DVBAORDT=$P(^DVB(396.4,DVBAORXM,0),U,6)
  1. .I DVBAORXM'="",('$D(^DVB(396.4,DVBAORXM,0))) S (DVBAORDT,DVBADTE)=""
  1. .S:DVBAORXM="" (DVBAORDT,DVBADTE)=""
  1. .S:DVBAORDT="" DVBADTE=""
  1. .I DVBAORDT'="" DO
  1. ..S DVBADTWK=$P(DVBAORDT,".",1)
  1. ..S DVBADTE=$$FMTE^XLFDT(DVBADTWK,"5DZ")
  1. .S DVBAORPV=$P(^DVB(396.4,XMDA,0),U,12)
  1. .S DVBABIEN=$P(^DVB(396.4,XMDA,0),U,2)
  1. .D CLAIMTYP,SPEC,PRIORITY
  1. .I DVBADLMTR="," D DETDELIM D:DVBAXDT]"" DETITEMS S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_$C(13),MSGCNT=MSGCNT+1 Q
  1. .S DVBAORP1=$E(DVBAORPV,1,15)
  1. .S DVBANAM1=$E(DVBANAME,1,15)
  1. .W !,DVBAORP1
  1. .W:$L(DVBAORPV)>$L(DVBAORP1) "**" ;**Indicate that Dr.'s Name truncated
  1. .W ?20,DVBADTE,?32,DVBANAM1
  1. .W:$L(DVBANAME)>$L(DVBANAM1) "**" ;**Indicate that Vet's Name truncated
  1. .W ?52,DVBASSN,?66,DVBACNUM
  1. .W !,?2,"Claim Type: "_DVBCTW,!,?2,"Special Consideration(s): "_DVBSCWA,!,?2,"Priority Of Exam: "_DVBPOX
  1. .I DVBAXDT]"" D
  1. ..W !,"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
  1. ..W !,"Reason: "_DVBAXRS_"."
  1. K DVBAA,DVBABIEN,DVBSC,DVBSCC,DVBSCN,DVBSCNS,DVBSCW,DVBSCWA,DVBPOX,DVBPOXID
  1. Q
  1. ;
  1. DETDELIM ; Print details of Insufficient Exams
  1. ; Reason,Exam,Provider,Exam Date,Patient Name,SSN,Claim #,Claim Type,Special Consideration(s),Priority of Exam
  1. I $D(^TMP("INSUFF",$J,MSGCNT)) D
  1. .S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR
  1. .S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_$C(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_"" Q
  1. I '$D(^TMP("INSUFF",$J,MSGCNT)) D
  1. .S ^TMP("INSUFF",$J,MSGCNT)=DVBADLMTR_DVBADLMTR_""""_DVBAORPV_""""_DVBADLMTR_DVBADTE_DVBADLMTR_""""_DVBANAME_""""_DVBADLMTR_DVBASSN_DVBADLMTR_$C(160)_DVBACNUM_DVBADLMTR_DVBCTW_DVBADLMTR_""""_DVBSCWA_""""_DVBADLMTR_DVBPOX_""
  1. Q
  1. ;
  1. DETITEMS ; Print final exam details
  1. S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_DVBADLMTR_"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
  1. S ^TMP("INSUFF",$J,MSGCNT)=^TMP("INSUFF",$J,MSGCNT)_DVBADLMTR_DVBAXRS_"."
  1. Q
  1. ;
  1. RESOUT ;** Output the Reason
  1. I DVBADLMTR="," S ^TMP("INSUFF",$J,MSGCNT)=$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)_DVBADLMTR Q
  1. W !!!!!,"Reason: ",$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)
  1. Q
  1. ;
  1. TYPEOUT ;** Output the Exam
  1. I DVBADLMTR="," D TYPEDLIM Q
  1. W !,"Exam: ",$P(^DVB(396.6,$P(^DVB(396.4,XMDA,0),U,3),0),U,2)
  1. W !,"Provider",?20,"Exam Dt",?32,"Patient Name",?52,"SSN",?66,"Claim #"
  1. Q
  1. ;
  1. TYPEDLIM ; ** Output the delimited Exam
  1. 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
  1. 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
  1. ;
  1. RSEL ;** Select Reasons
  1. ;** The selection prompt is defaulted to ALL. If the user selects
  1. ;** 'All', only reasons for exams entered on requests with a
  1. ;** priority of 'Insufficient' will be reported. Not all reasons.
  1. ;
  1. W @IOF,!
  1. W !,"Insufficient Reason Selection"
  1. S DVBCYQ=""
  1. N RESANS,DVBAOUT S DVBAOUT="" ;**Pre-read
  1. K Y,DTOUT,DUOUT,DVBATSAV
  1. F Q:(DVBAOUT=1!(DVBCYQ=1)) DO
  1. .W !!," Enter '^' to end Reason Selection"
  1. .W !," 'Return' to select all Insufficient Reasons",!
  1. .K DIC,DTOUT,DUOUT,Y
  1. .W !," Enter Insufficient Reason: ALL//"
  1. .R RESANS:DTIME
  1. .S:$T DVBATSAV=""
  1. .I RESANS=""&($D(DVBATSAV)) S Y=-1 D INREAS^DVBCIUT1
  1. .S:('$D(DVBATSAV)!(RESANS["^")) DVBAOUT="1"
  1. .I DVBAOUT'=1,('$D(Y)) DO
  1. ..I RESANS["?" DO
  1. ...N LPDA S LPDA=0
  1. ...W !,"CHOOSE FROM:"
  1. ...F S LPDA=$O(^DVB(396.94,LPDA)) Q:+LPDA'>0 DO
  1. ....W !,?3,$P(^DVB(396.94,LPDA,0),U,1)
  1. ...W !
  1. ..I RESANS'["?" DO
  1. ...S DIC="^DVB(396.94,"
  1. ...S DIC(0)="EMQ"
  1. ...S X=RESANS
  1. ...D ^DIC
  1. ...D:+Y>0 INREAS^DVBCIUT1
  1. .I RESANS="",($D(Y)&(+Y=-1)) S DVBCYQ=1
  1. K DTOUT,DUOUT,Y,DIC,DVBCYQ,DVBATSAV
  1. Q
  1. ;
  1. XMSEL ;** Select Exams
  1. ;** The selection prompt is defaulted to ALL. If the user selects
  1. ;** 'All', only exams entered on requests with a priority of
  1. ;** 'Insufficient' will be reported. Not all exams.
  1. ;
  1. W @IOF,!
  1. W !,"AMIE Exam Selection"
  1. S DVBCYQ=""
  1. K Y,DTOUT,DUOUT
  1. F Q:($D(DTOUT)!($D(DUOUT)!(DVBCYQ=1))) DO
  1. .W !!," Enter '^' to end Exam Selection"
  1. .W !," 'Return' to select all AMIE Exams",!
  1. .K DIC,DTOUT,DUOUT
  1. .S DIC="^DVB(396.6,"
  1. .S DIC(0)="AEMQ"
  1. .S DIC("A")=" Enter Exam: ALL//"
  1. .;removed screen for inactive exams
  1. .D ^DIC
  1. .I '$D(DTOUT),('$D(DUOUT)) D EXMTPE^DVBCIUT1
  1. .I $D(Y),(+Y=-1) S DVBCYQ=1
  1. K DTOUT,DUOUT,Y,DIC,DVBCYQ
  1. Q
  1. ;
  1. ;Input: DVBADIRA - Prompt to display for DIR call
  1. ;Ouput: Code selected from set or ^ if user exited selection
  1. EXMPRTY(DVBADIRA) ;** Select Priority of Exam
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="S^AO:Agent Orange;BDD:Benefits Delivery at Discharge / Quick Start;"
  1. S DIR(0)=DIR(0)_"IDES:Integrated Disability Evaluation System;"
  1. S DIR(0)=DIR(0)_"ALL:All Others"
  1. S DIR("A")=$S($G(DVBADIRA)]"":DVBADIRA,1:"Select Priority of Exam for the Report")
  1. S DIR("B")="All Others"
  1. S DIR("T")=DTIME ;time-out value specified by system
  1. S DIR("?",1)="Select the priority of exam(s) to report on or ALL for the original report,"
  1. S DIR("?")="which excludes the AO, BDD and IDES exam priorities."
  1. D ^DIR
  1. Q Y
  1. CLAIMTYP ;THE CLAIM TYPE OF A 2507 REQUEST
  1. S DVBCTW=""
  1. Q:'$D(^DVB(396.3,DVBABIEN,9,0))
  1. ;DVBIEN is the 2507 REQUEST FILE IEN
  1. ;DVBCTW is the string /name of the CLAIM TYPE
  1. D GETS^DIQ(396.3,DVBABIEN_",","9.1*","E","MSG","ERR")
  1. S DVBCTW=MSG("396.32","1,"_DVBABIEN_",",".01","E")
  1. Q
  1. SPEC ;SPECIAL CONSIDERATION(S) FOR A 2507 REQUEST
  1. K DVBSCW
  1. S DVBSCWA=""
  1. Q:'$D(^DVB(396.3,DVBABIEN,8))
  1. ;DVBABIEN is the 2507 REQUEST FILE IEN
  1. ;DVBSC is a the SPECIAL CONSIDERATION entry for the 2507 REQUEST
  1. ;DVBSCN is the pointer number to the SPECIAL CONSIDERATION file 396.25
  1. ;DVBSCW is the string /name of the SPECIAL CONSIDERATION
  1. S DVBAA=$P(^DVB(396.3,DVBABIEN,8,0),U,4)
  1. S (DVBSC,DVBCNT)=0 F S DVBSC=$O(^DVB(396.3,DVBABIEN,8,DVBSC)) Q:'DVBSC D
  1. .S DVBSCN=$P(^DVB(396.3,DVBABIEN,8,DVBSC,0),U,1)
  1. .S DVBSCW(DVBSC)=$G(^DVB(396.25,DVBSCN,0))
  1. .S DVBCNT=DVBCNT+1
  1. .I (DVBCNT'=DVBAA) S:$D(DVBSCW(DVBSC)) DVBSCW(DVBSC)=DVBSCW(DVBSC)_","
  1. S DVBX="" F S DVBX=$O(DVBSCW(DVBX)) Q:'DVBX S DVBSCWA=DVBSCWA_DVBSCW(DVBX)
  1. Q
  1. PRIORITY ;
  1. S DVBPOX=""
  1. Q:($P(^DVB(396.3,DVBABIEN,0),U,10))=""
  1. S DVBPOXID=$P(^DVB(396.3,DVBABIEN,0),U,10)
  1. S DVBPOX=$$GET1^DIQ(396.3,DVBABIEN,"PRIORITY OF EXAM")
  1. Q