- DVBCIRP1 ;ALB/GTS-AMIE INSUFFICIENT 2507 RPT -CONT 1 ; 11/10/94 1:30 PM
- ;;2.7;AMIE;**13,19,27,149,184,185**;Apr 10, 1995;Build 18
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;** Version Changes
- ; 2.7 - New routine (Enhc 15)
- ;
- SUMRPT ;**Output the summary report
- W:IOST?1"C-".E @IOF
- D SUMHD
- ;print request data
- W !?3,"Total 2507 requests received for date range:",?71,$J(DVBARQCT,5)
- W !?3,"Total insufficient 2507 requests received for date range:",?71,$J(DVBAINRQ,5)
- W !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$J(DVBACAN("REQ"),5)
- I DVBARQCT>0 D
- .S PERCENT=(DVBAINRQ/DVBARQCT)*100
- .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
- .S PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
- .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
- I DVBARQCT'>0 D
- .S PERCENT=0
- .W !?3,"% of insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
- .W !?3,"% of uncancelled insufficient requests per total requests received:",?71,$J(PERCENT,5,1)_"%"
- ;print exam data
- W !!?3,"Total 2507 exams received for date range:",?71,$J(DVBAXMCT,5)
- W !?3,"Total insufficient 2507 exams received for date range:",?71,$J(DVBAINXM,5)
- W !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$J(DVBACAN("EXM"),5)
- I DVBAXMCT>0 D
- .S PERCENT=(DVBAINXM/DVBAXMCT)*100
- .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
- .S PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
- .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
- I DVBAXMCT'>0 D
- .S PERCENT=0
- .W !?3,"% of insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
- .W !?3,"% of uncancelled insufficient exams per total exams received:",?71,$J(PERCENT,5,1)_"%"
- ;print insufficient reason data
- I IOST?1"C-".E DO
- .K DTOUT,DUOUT
- .W !!
- .D PAUSE^DVBCUTL4
- .I '$D(DTOUT),('$D(DUOUT)) DO
- ..W @IOF
- ..D SUMHD
- I '$D(DTOUT),('$D(DUOUT)) DO
- .W:IOST'?1"C-".E !!
- .W !?15,"Summary of insufficient exams per Reason",!
- .W !?3,"Reason",?53,"Num",?59,"Percent"
- .N DVBARSLP S DVBARSLP=""
- .F S DVBARSLP=$O(DVBAINXM(DVBARSLP)) Q:DVBARSLP="" DO ;**Reason tot's
- ..W:+DVBARSLP>0 !?3,$P(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
- ..I +DVBARSLP'>0,(+DVBAINXM(DVBARSLP)>0) W !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
- ..W:(+DVBAINXM(DVBARSLP)>0&(DVBAINXM>0)) ?59,($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",1))_$S($E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1)'="":"."_$E($P(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1),1:"")_" %"
- .I IOST?1"C-".E DO
- ..D CONTMES^DVBCUTL4
- Q
- ;
- SUMHD ;** Output Summary Report heading
- N STRTDT,LSTDT,DVBATXT,DVBASL
- W !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
- S Y=$P(BEGDT,".",1) X ^DD("DD") S STRTDT=Y K Y
- S Y=$P(ENDDT,".",1) X ^DD("DD") S LSTDT=Y K Y
- S DVBASL=$L($$SITE^DVBCUTL4)
- S DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
- W ?(((67+DVBASL)-$L(DVBATXT))\2),DVBATXT,!
- W !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
- Q
- ;
- DETAIL ;** Output reason, exam type and exam info
- N STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
- S MSGCNT=0
- K ^TMP("DVBAEXAMS",$J),^TMP("INSUFF",$J)
- S X=$P(BEGDT,".",1),STRTDT=$$FMTE^XLFDT(X,"5DZ")
- S Y=$P(ENDDT,".",1),LSTDT=$$FMTE^XLFDT(Y,"5DZ")
- U IO
- S DVBADTLP=BEGDT
- S DVBAENDL=ENDDT
- S DVBAPRTY=$S(($G(DVBAPRTY)["BDD"):";BDD;QS;",($G(DVBAPRTY)["IDES"):";IDES;",($G(DVBAPRTY)["AO"):";AO;",1:"")
- D:((DVBAPRTY']"")!(DVBAPRTY["AO")!(DVBAPRTY["IDES")) DETHD^DVBCIUTL
- S RSDA=""
- S DVBAPG1=""
- F S RSDA=$O(DVBAARY("REASON",RSDA)) Q:(RSDA=""!($D(GETOUT))) DO
- .K DVBARSPT
- .S TPDA=""
- .F S TPDA=$O(^TMP($J,"XMTYPE",TPDA)) Q:(TPDA=""!($D(GETOUT))) DO
- ..K DVBAXMPT
- ..S XMDA=""
- ..F S XMDA=$O(^DVB(396.4,"AIT",RSDA,TPDA,XMDA)) Q:(XMDA=""!($D(GETOUT))) DO
- ...S DVBARQST=$G(^DVB(396.3,$P(^DVB(396.4,XMDA,0),U,2),0))
- ...;retrieve Priority of Exam from Current/Parent(if exists) 2507 Request
- ...S DVBAPREXM=$$CHKREQ($P(^DVB(396.4,XMDA,0),U,2))
- ...I $P(DVBARQST,U,5)>DVBADTLP,($P(DVBARQST,U,5)<DVBAENDL) D
- ....;Current-As Is (All Others, except new priorities)
- ....D:((DVBAPRTY']"")&((";BDD;QS;IDES;AO;")'[(";"_DVBAPREXM_";"))) EXMOUT^DVBCIUTL
- ....;Report for Specific Priority of Exam(s)
- ....D:((DVBAPRTY]"")&(DVBAPRTY[(";"_DVBAPREXM_";")))
- .....D:(DVBAPREXM="AO")!(DVBAPREXM="IDES") EXMOUT^DVBCIUTL ;Agent Orange or IDES Single Report
- .....;BDD,QS require report for each priority code
- .....;for performance grab all data then print 2 reports
- .....S:(DVBAPREXM'="AO")&(DVBAPREXM'="IDES") ^TMP("DVBAEXAMS",$J,DVBAPREXM,RSDA,TPDA,XMDA)=""
- I '$D(GETOUT),(IOST?1"C-".E),((DVBAPRTY']"")!(DVBAPRTY["AO")) D CONTMES^DVBCUTL4
- D:((DVBAPRTY]"")&(DVBAPRTY'["AO")&(DVBAPRTY'["IDES")) ;print BDD reports
- .K DVBAPG1 S DVBAEXMP=DVBAPRTY,RSDA=""
- .F DVBAP=$P(DVBAEXMP,";",2),$P(DVBAEXMP,";",3) D
- ..Q:DVBAP=""
- ..S DVBAPRTY=DVBAP
- ..D DETHD^DVBCIUTL S DVBAPG1=""
- ..F S RSDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA)) Q:(('+RSDA)!($D(GETOUT))) D
- ...K DVBARSPT S TPDA=""
- ...F S TPDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA,TPDA)) Q:(('+TPDA)!($D(GETOUT))) D
- ....K DVBAXMPT S XMDA=""
- ....F S XMDA=$O(^TMP("DVBAEXAMS",$J,DVBAP,RSDA,TPDA,XMDA)) Q:(('+XMDA)!($D(GETOUT))) D EXMOUT^DVBCIUTL
- ..I '$D(GETOUT),(IOST?1"C-".E) D CONTMES^DVBCUTL4
- ..K GETOUT W !
- D ^%ZISC
- D KVARS ;**KILL the variables used by DETAIL
- Q
- ;
- KVARS ;** Final Kill for Detail report
- S:$D(ZTQUEUED) ZTREQ="@"
- K ^TMP($J),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP,DVBAENDL
- K DVBARSPT,DVBAXMPT,REQDA,DFN,DVBAORXM,DVBAXMTP,DVBACMND,DVBAORPV,DVBAORP1
- K DVBADTWK,DVBADTE,DVBAORDT,DVBANAM1,GETOUT,DVBAARY,DVBAPG1,DVBARQDT,DVBAXDT
- K DVBAXRS,MSGCNT,^TMP("DVBAEXAMS",$J)
- Q
- ;
- DETSEL ;** Select the details to report
- D RSEL^DVBCIUTL
- I '$D(DVBAARY("REASON")) S DVBAQTSL=""
- I $D(DVBAQTSL) DO
- .S DIR("A",1)="You have not selected Insufficient reasons to report."
- .S DIR("A",2)="This is required to print the Detailed report."
- .S DIR("A",3)=" "
- .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
- I '$D(DVBAQTSL) DO
- .D XMSEL^DVBCIUTL
- .I '$D(^TMP($J,"XMTYPE")) S DVBAQTSL=""
- .I $D(DVBAQTSL) DO
- ..S DIR("A",1)="You have not selected Exams to report."
- ..S DIR("A",2)="This is required to print the Detailed report."
- ..S DIR("A",3)=" "
- ..S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
- ..K DVBAARY("REASON")
- Q
- ;
- ;Input: IEN of 2507 Request in File #396.3
- ;Output: Priority of Exam for the Current/Parent 2507 Request
- CHKREQ(DVBARIEN) ;check for parent requests
- N DVBAPIEN,DVBAPEXM
- Q:($G(DVBARIEN)']"") ""
- S DVBAPEXM=$P($G(^DVB(396.3,DVBARIEN,0)),U,10) ;Priority of Exam
- S DVBAPIEN=$P($G(^DVB(396.3,DVBARIEN,5)),U) ;parent IEN if it exists
- I (DVBAPIEN]"") D ;Parent 2507 Request
- .S DVBAPEXM=$P($G(^DVB(396.3,DVBAPIEN,0)),U,10) ;Priority of Exam
- Q DVBAPEXM
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCIRP1 7117 printed Feb 18, 2025@23:10:56 Page 2
- DVBCIRP1 ;ALB/GTS-AMIE INSUFFICIENT 2507 RPT -CONT 1 ; 11/10/94 1:30 PM
- +1 ;;2.7;AMIE;**13,19,27,149,184,185**;Apr 10, 1995;Build 18
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;** Version Changes
- +5 ; 2.7 - New routine (Enhc 15)
- +6 ;
- SUMRPT ;**Output the summary report
- +1 if IOST?1"C-".E
- WRITE @IOF
- +2 DO SUMHD
- +3 ;print request data
- +4 WRITE !?3,"Total 2507 requests received for date range:",?71,$JUSTIFY(DVBARQCT,5)
- +5 WRITE !?3,"Total insufficient 2507 requests received for date range:",?71,$JUSTIFY(DVBAINRQ,5)
- +6 WRITE !?3,"Total insufficient 2507 requests cancelled by RO for date range:",?71,$JUSTIFY(DVBACAN("REQ"),5)
- +7 IF DVBARQCT>0
- Begin DoDot:1
- +8 SET PERCENT=(DVBAINRQ/DVBARQCT)*100
- +9 WRITE !?3,"% of insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- +10 SET PERCENT=((DVBAINRQ-DVBACAN("REQ"))/DVBARQCT)*100
- +11 WRITE !?3,"% of uncancelled insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- End DoDot:1
- +12 IF DVBARQCT'>0
- Begin DoDot:1
- +13 SET PERCENT=0
- +14 WRITE !?3,"% of insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- +15 WRITE !?3,"% of uncancelled insufficient requests per total requests received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- End DoDot:1
- +16 ;print exam data
- +17 WRITE !!?3,"Total 2507 exams received for date range:",?71,$JUSTIFY(DVBAXMCT,5)
- +18 WRITE !?3,"Total insufficient 2507 exams received for date range:",?71,$JUSTIFY(DVBAINXM,5)
- +19 WRITE !?3,"Total insufficient 2507 exams cancelled by RO for date range:",?71,$JUSTIFY(DVBACAN("EXM"),5)
- +20 IF DVBAXMCT>0
- Begin DoDot:1
- +21 SET PERCENT=(DVBAINXM/DVBAXMCT)*100
- +22 WRITE !?3,"% of insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- +23 SET PERCENT=((DVBAINXM-DVBACAN("EXM"))/DVBAXMCT)*100
- +24 WRITE !?3,"% of uncancelled insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- End DoDot:1
- +25 IF DVBAXMCT'>0
- Begin DoDot:1
- +26 SET PERCENT=0
- +27 WRITE !?3,"% of insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- +28 WRITE !?3,"% of uncancelled insufficient exams per total exams received:",?71,$JUSTIFY(PERCENT,5,1)_"%"
- End DoDot:1
- +29 ;print insufficient reason data
- +30 IF IOST?1"C-".E
- Begin DoDot:1
- +31 KILL DTOUT,DUOUT
- +32 WRITE !!
- +33 DO PAUSE^DVBCUTL4
- +34 IF '$DATA(DTOUT)
- IF ('$DATA(DUOUT))
- Begin DoDot:2
- +35 WRITE @IOF
- +36 DO SUMHD
- End DoDot:2
- End DoDot:1
- +37 IF '$DATA(DTOUT)
- IF ('$DATA(DUOUT))
- Begin DoDot:1
- +38 if IOST'?1"C-".E
- WRITE !!
- +39 WRITE !?15,"Summary of insufficient exams per Reason",!
- +40 WRITE !?3,"Reason",?53,"Num",?59,"Percent"
- +41 NEW DVBARSLP
- SET DVBARSLP=""
- +42 ;**Reason tot's
- FOR
- SET DVBARSLP=$ORDER(DVBAINXM(DVBARSLP))
- if DVBARSLP=""
- QUIT
- Begin DoDot:2
- +43 if +DVBARSLP>0
- WRITE !?3,$PIECE(^DVB(396.94,DVBARSLP,0),U,3),?53,DVBAINXM(DVBARSLP)
- +44 IF +DVBARSLP'>0
- IF (+DVBAINXM(DVBARSLP)>0)
- WRITE !?3,"Exams without insufficient reason indicated",?53,DVBAINXM(DVBARSLP)
- +45 if (+DVBAINXM(DVBARSLP)>0&(DVBAINXM>0))
- WRITE ?59,($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",1))_$SELECT($EXTRACT($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1)'="":"."_$EXTRACT($PIECE(((DVBAINXM(DVBARSLP)/DVBAINXM)*100),".",2),1,1),1:"")_" %"
- End DoDot:2
- +46 IF IOST?1"C-".E
- Begin DoDot:2
- +47 DO CONTMES^DVBCUTL4
- End DoDot:2
- End DoDot:1
- +48 QUIT
- +49 ;
- SUMHD ;** Output Summary Report heading
- +1 NEW STRTDT,LSTDT,DVBATXT,DVBASL
- +2 WRITE !?15,"Summary Insufficient Exam Report for ",$$SITE^DVBCUTL4(),!
- +3 SET Y=$PIECE(BEGDT,".",1)
- XECUTE ^DD("DD")
- SET STRTDT=Y
- KILL Y
- +4 SET Y=$PIECE(ENDDT,".",1)
- XECUTE ^DD("DD")
- SET LSTDT=Y
- KILL Y
- +5 SET DVBASL=$LENGTH($$SITE^DVBCUTL4)
- +6 SET DVBATXT=$$PRHD^DVBCIUTL(DVBAPRTY)
- +7 WRITE ?(((67+DVBASL)-$LENGTH(DVBATXT))\2),DVBATXT,!
- +8 WRITE !?16,"For Date Range: "_STRTDT_" to "_LSTDT,!
- +9 QUIT
- +10 ;
- DETAIL ;** Output reason, exam type and exam info
- +1 NEW STRTDT,LSTDT,DVBARQST,DVBAEXMP,DVBAP,DVBAPREXM,MSGCNT
- +2 SET MSGCNT=0
- +3 KILL ^TMP("DVBAEXAMS",$JOB),^TMP("INSUFF",$JOB)
- +4 SET X=$PIECE(BEGDT,".",1)
- SET STRTDT=$$FMTE^XLFDT(X,"5DZ")
- +5 SET Y=$PIECE(ENDDT,".",1)
- SET LSTDT=$$FMTE^XLFDT(Y,"5DZ")
- +6 USE IO
- +7 SET DVBADTLP=BEGDT
- +8 SET DVBAENDL=ENDDT
- +9 SET DVBAPRTY=$SELECT(($GET(DVBAPRTY)["BDD"):";BDD;QS;",($GET(DVBAPRTY)["IDES"):";IDES;",($GET(DVBAPRTY)["AO"):";AO;",1:"")
- +10 if ((DVBAPRTY']"")!(DVBAPRTY["AO")!(DVBAPRTY["IDES"))
- DO DETHD^DVBCIUTL
- +11 SET RSDA=""
- +12 SET DVBAPG1=""
- +13 FOR
- SET RSDA=$ORDER(DVBAARY("REASON",RSDA))
- if (RSDA=""!($DATA(GETOUT)))
- QUIT
- Begin DoDot:1
- +14 KILL DVBARSPT
- +15 SET TPDA=""
- +16 FOR
- SET TPDA=$ORDER(^TMP($JOB,"XMTYPE",TPDA))
- if (TPDA=""!($DATA(GETOUT)))
- QUIT
- Begin DoDot:2
- +17 KILL DVBAXMPT
- +18 SET XMDA=""
- +19 FOR
- SET XMDA=$ORDER(^DVB(396.4,"AIT",RSDA,TPDA,XMDA))
- if (XMDA=""!($DATA(GETOUT)))
- QUIT
- Begin DoDot:3
- +20 SET DVBARQST=$GET(^DVB(396.3,$PIECE(^DVB(396.4,XMDA,0),U,2),0))
- +21 ;retrieve Priority of Exam from Current/Parent(if exists) 2507 Request
- +22 SET DVBAPREXM=$$CHKREQ($PIECE(^DVB(396.4,XMDA,0),U,2))
- +23 IF $PIECE(DVBARQST,U,5)>DVBADTLP
- IF ($PIECE(DVBARQST,U,5)<DVBAENDL)
- Begin DoDot:4
- +24 ;Current-As Is (All Others, except new priorities)
- +25 if ((DVBAPRTY']"")&((";BDD;QS;IDES;AO;")'[(";"_DVBAPREXM_";")))
- DO EXMOUT^DVBCIUTL
- +26 ;Report for Specific Priority of Exam(s)
- +27 if ((DVBAPRTY]"")&(DVBAPRTY[(";"_DVBAPREXM_";")))
- Begin DoDot:5
- +28 ;Agent Orange or IDES Single Report
- if (DVBAPREXM="AO")!(DVBAPREXM="IDES")
- DO EXMOUT^DVBCIUTL
- +29 ;BDD,QS require report for each priority code
- +30 ;for performance grab all data then print 2 reports
- +31 if (DVBAPREXM'="AO")&(DVBAPREXM'="IDES")
- SET ^TMP("DVBAEXAMS",$JOB,DVBAPREXM,RSDA,TPDA,XMDA)=""
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 IF '$DATA(GETOUT)
- IF (IOST?1"C-".E)
- IF ((DVBAPRTY']"")!(DVBAPRTY["AO"))
- DO CONTMES^DVBCUTL4
- +33 ;print BDD reports
- if ((DVBAPRTY]"")&(DVBAPRTY'["AO")&(DVBAPRTY'["IDES"))
- Begin DoDot:1
- +34 KILL DVBAPG1
- SET DVBAEXMP=DVBAPRTY
- SET RSDA=""
- +35 FOR DVBAP=$PIECE(DVBAEXMP,";",2),$PIECE(DVBAEXMP,";",3)
- Begin DoDot:2
- +36 if DVBAP=""
- QUIT
- +37 SET DVBAPRTY=DVBAP
- +38 DO DETHD^DVBCIUTL
- SET DVBAPG1=""
- +39 FOR
- SET RSDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA))
- if (('+RSDA)!($DATA(GETOUT)))
- QUIT
- Begin DoDot:3
- +40 KILL DVBARSPT
- SET TPDA=""
- +41 FOR
- SET TPDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA,TPDA))
- if (('+TPDA)!($DATA(GETOUT)))
- QUIT
- Begin DoDot:4
- +42 KILL DVBAXMPT
- SET XMDA=""
- +43 FOR
- SET XMDA=$ORDER(^TMP("DVBAEXAMS",$JOB,DVBAP,RSDA,TPDA,XMDA))
- if (('+XMDA)!($DATA(GETOUT)))
- QUIT
- DO EXMOUT^DVBCIUTL
- End DoDot:4
- End DoDot:3
- +44 IF '$DATA(GETOUT)
- IF (IOST?1"C-".E)
- DO CONTMES^DVBCUTL4
- +45 KILL GETOUT
- WRITE !
- End DoDot:2
- End DoDot:1
- +46 DO ^%ZISC
- +47 ;**KILL the variables used by DETAIL
- DO KVARS
- +48 QUIT
- +49 ;
- KVARS ;** Final Kill for Detail report
- +1 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 KILL ^TMP($JOB),DVBAARY,DVBANAME,DVBASSN,DVBACNUM,RSDA,TPDA,XMDA,DVBADTLP,DVBAENDL
- +3 KILL DVBARSPT,DVBAXMPT,REQDA,DFN,DVBAORXM,DVBAXMTP,DVBACMND,DVBAORPV,DVBAORP1
- +4 KILL DVBADTWK,DVBADTE,DVBAORDT,DVBANAM1,GETOUT,DVBAARY,DVBAPG1,DVBARQDT,DVBAXDT
- +5 KILL DVBAXRS,MSGCNT,^TMP("DVBAEXAMS",$JOB)
- +6 QUIT
- +7 ;
- DETSEL ;** Select the details to report
- +1 DO RSEL^DVBCIUTL
- +2 IF '$DATA(DVBAARY("REASON"))
- SET DVBAQTSL=""
- +3 IF $DATA(DVBAQTSL)
- Begin DoDot:1
- +4 SET DIR("A",1)="You have not selected Insufficient reasons to report."
- +5 SET DIR("A",2)="This is required to print the Detailed report."
- +6 SET DIR("A",3)=" "
- +7 SET DIR(0)="FAO^1:1"
- SET DIR("A")="Hit Return to continue."
- DO ^DIR
- KILL DIR,X,Y
- End DoDot:1
- +8 IF '$DATA(DVBAQTSL)
- Begin DoDot:1
- +9 DO XMSEL^DVBCIUTL
- +10 IF '$DATA(^TMP($JOB,"XMTYPE"))
- SET DVBAQTSL=""
- +11 IF $DATA(DVBAQTSL)
- Begin DoDot:2
- +12 SET DIR("A",1)="You have not selected Exams to report."
- +13 SET DIR("A",2)="This is required to print the Detailed report."
- +14 SET DIR("A",3)=" "
- +15 SET DIR(0)="FAO^1:1"
- SET DIR("A")="Hit Return to continue."
- DO ^DIR
- KILL DIR,X,Y
- +16 KILL DVBAARY("REASON")
- End DoDot:2
- End DoDot:1
- +17 QUIT
- +18 ;
- +19 ;Input: IEN of 2507 Request in File #396.3
- +20 ;Output: Priority of Exam for the Current/Parent 2507 Request
- CHKREQ(DVBARIEN) ;check for parent requests
- +1 NEW DVBAPIEN,DVBAPEXM
- +2 if ($GET(DVBARIEN)']"")
- QUIT ""
- +3 ;Priority of Exam
- SET DVBAPEXM=$PIECE($GET(^DVB(396.3,DVBARIEN,0)),U,10)
- +4 ;parent IEN if it exists
- SET DVBAPIEN=$PIECE($GET(^DVB(396.3,DVBARIEN,5)),U)
- +5 ;Parent 2507 Request
- IF (DVBAPIEN]"")
- Begin DoDot:1
- +6 ;Priority of Exam
- SET DVBAPEXM=$PIECE($GET(^DVB(396.3,DVBAPIEN,0)),U,10)
- End DoDot:1
- +7 QUIT DVBAPEXM