- DVBCAMR2 ;ALB/GTS-557/THM-REGIONAL OFFICE AMIS 290 REPORT, CALCULATIONS ; 9/28/91 6:43 AM
- ;;2.7;AMIE;**149,184**;Apr 10, 1995;Build 10
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;** Version Changes
- ; 2.7 - GTS/Coded to adjust 35 day clock calc (Enhc 13)
- ;
- DAY30 ;exam completion
- N DVBADTS,DVBAPPTS,DVBACNT,DVBADTM,DVBANDE,X,X1,X2
- K ^TMP("DVBC",$J),^TMP($J,"SDAMA301")
- ;DES Type exams required to be completed in 45 days, all others 30
- S DVBADTS=$S(((";IDES;")[(";"_DVBAPREXM_";")):45,1:30)
- ;setup call to scheduling API
- S DVBAPPTS(1)=DTRPT_";"_EDATE,DVBAPPTS(4)=PNAM,DVBAPPTS(3)="R;I;NT"
- S DVBAPPTS("SORT")="P",DVBAPPTS("FLDS")="10"
- S DVBACNT=$$SDAPI^SDAMA301(.DVBAPPTS)
- I (DVBACNT'>0) K ^TMP($J,"SDAMA301") Q
- S DVBADTM=""
- F S DVBADTM=$O(^TMP($J,"SDAMA301",PNAM,DVBADTM)) Q:('+DVBADTM) D
- .S ^TMP("DVBC",$J,9999999-DVBADTM,DVBADTM)=""
- S DVBANDE=$O(^TMP("DVBC",$J,0)),DVBADTM=$O(^TMP("DVBC",$J,DVBANDE,0))
- D:(DVBADTM]"")
- .S X2=DVBADTM,X1=$S(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW)
- .D ^%DTC ;calculate date diff
- .S:(X>DVBADTS) TOT(DVBAPREXM,"30DAYEX")=TOT(DVBAPREXM,"30DAYEX")+1
- K ^TMP($J,"SDAMA301")
- Q
- ;
- PENDCNT I X'<0&(X'>90) S TOT(DVBAPREXM,"P90")=TOT(DVBAPREXM,"P90")+1
- I X>90&(X'>120) S TOT(DVBAPREXM,"P121")=TOT(DVBAPREXM,"P121")+1
- I X>120&(X'>150) S TOT(DVBAPREXM,"P151")=TOT(DVBAPREXM,"P151")+1
- I X>150&(X'>180) S TOT(DVBAPREXM,"P181")=TOT(DVBAPREXM,"P181")+1
- I X>180&(X'>365) S TOT(DVBAPREXM,"P365")=TOT(DVBAPREXM,"P365")+1
- I X>365 S TOT(DVBAPREXM,"P366")=TOT(DVBAPREXM,"P366")+1
- Q
- ;
- SET ;
- N DVBAPREXM
- S DTA=^DVB(396.3,REQDA,0),DTREQ=$P(DTA,U,2),XRONUM=$P(DTA,U,3),XRONUM=$S($D(^DIC(4,+XRONUM,99)):$P(^(99),U,1),1:0) Q:XRONUM'=RONUM&(RONUM'="ALL")
- K XRONUM S DTRPT=$P(DTA,U,5),DTSCHEDC=$P(DTA,U,6),DTRQCMP=$P(DTA,U,7),DTTRANS=$P(DTA,U,12),DTREL=$P(DTA,U,14),RQSTAT=$P(DTA,U,18),DTCAN=$P(DTA,U,19),PRIO=$P(DTA,U,10) K DTA
- I DTRPT="",DTCAN]"" S DTRPT=DTCAN
- Q:DTRPT="" ;requests never printed
- ;check for Parent Request (retrieve current/parent Priority of Exam)
- S DVBAPREXM=$$CHKREQ^DVBCIRP1(REQDA)
- ;original report run (Exclude new priorities)
- Q:((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
- ;report for specific priority
- Q:((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
- S:(DVBAEXMP']"") DVBAPREXM="ALL" ;identifier for totals
- I DTREL'<BDATE,DTREL'>EDATE D DAY30
- I DTRPT'<BDATE,DTRPT'>EDATE S TOT(DVBAPREXM,"SENT")=TOT(DVBAPREXM,"SENT")+1
- I DTRPT'<BDATE,DTRPT'>EDATE,RQSTAT'["X" S X1=$S(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW),X2=DTRPT D ^%DTC I X>3 S TOT(DVBAPREXM,"3DAYSCH")=TOT(DVBAPREXM,"3DAYSCH")+1
- I DTREL'<BDATE&(DTREL'>EDATE),RQSTAT="C"!(RQSTAT="R") S:PRIO'="E" DVBCPCTM=$$PROCDAY^DVBCUTL2(REQDA) S:PRIO="E" DVBCPCTM=$$INSFTME^DVBCUTA1(REQDA) S TOT(DVBAPREXM,"DAYS")=TOT(DVBAPREXM,"DAYS")+DVBCPCTM K DVBCPCTM
- I DTRPT'>EDATE,"^P^S^T"[RQSTAT S TOT(DVBAPREXM,"PENDADJ")=TOT(DVBAPREXM,"PENDADJ")+1,X1=EDATE,X2=DTRPT D ^%DTC,PENDCNT
- I DTRPT'>EDATE,"^C^CT^R^RX^X^"[RQSTAT,(+DTREL>EDATE)!(+DTCAN>EDATE) S TOT(DVBAPREXM,"PENDADJ")=TOT(DVBAPREXM,"PENDADJ")+1,X1=EDATE,X2=DTRPT D ^%DTC,PENDCNT
- I DTREL'<BDATE&(DTREL'>EDATE),RQSTAT["C"!(RQSTAT="R") S TOT(DVBAPREXM,"COMPLETED")=TOT(DVBAPREXM,"COMPLETED")+1
- I DTRPT'<BDATE,DTRPT'>EDATE,PRIO="E" S TOT(DVBAPREXM,"INSUFF")=TOT(DVBAPREXM,"INSUFF")+1
- I DTCAN'<BDATE&(DTCAN'>EDATE),RQSTAT="X"!(RQSTAT="RX") S TOT(DVBAPREXM,"INCOMPLETE")=TOT(DVBAPREXM,"INCOMPLETE")+1
- K DTRPT Q
- ;
- GO ;
- N DVBAEXMP,DVBAP,DVBAPREXM,DVBATOT,DVBAOUT,PG
- S PG=0
- S DVBAEXMP=$S($G(DVBAPRTY)["BDD":";BDD;QS;",($G(DVBAPRTY)["IDES"):";IDES;",($G(DVBAPRTY)["AO"):";AO;",1:"")
- S %DT="TS",X="NOW" D ^%DT S DVBCNOW=Y K ^TMP($J)
- S PNAM="" F JJ=0:0 S PNAM=$O(^DVB(396.3,"B",PNAM)) Q:PNAM="" F REQDA=0:0 S REQDA=$O(^DVB(396.3,"B",PNAM,REQDA)) Q:REQDA="" D SET
- ;
- S DVBAEXMP=$S($G(DVBAPRTY)["BDD":"BDD,QS",($G(DVBAPRTY)["IDES"):"IDES",($G(DVBAPRTY)["AO"):"AO",1:"ALL")
- M DVBATOT=TOT ;save totals for all priorities into new array
- F DVBAP=1:1:$L(DVBAEXMP,",") D
- .K DVBAOUT S DVBAPREXM=$P(DVBAEXMP,",",DVBAP)
- .;re-create TOT array for each priority of exam
- .D CRTOT(DVBAPREXM,.DVBATOT,.TOT)
- .S TOT("AVGDAYS")=0
- .I TOT("COMPLETED")>0 S TOT("AVGDAYS")=TOT("DAYS")/TOT("COMPLETED"),TOT("AVGDAYS")=$J(TOT("AVGDAYS"),5,1)
- .D BULLTXT^DVBCAMR1(DVBAPREXM)
- .U IO D HDR F JI=0.9:0 S JI=$O(^TMP($J,JI)) Q:JI="" W ^(JI,0),! I IOST?1"C-".E,$Y>19 D PAUSE G:$D(DVBAOUT) EXIT D HDR
- .D PAUSE I $D(DVBAOUT) W:SBULL="Y" !!,*7,"Bulletin will NOT be sent!!",*7,! H 2 G EXIT
- .S:'$D(XMY) SBULL="N" I SBULL="Y" D SEND
- D ^%ZISC
- ;
- EXIT ;
- Q:(DVBAP'=$L(DVBAEXMP,",")) ;another report to run
- D:$D(ZTQUEUED) KILL^%ZTLOAD K PREVMO,UPDATE,XMY G KILL^DVBCUTIL
- ;
- BULL W ! S XMDUZ=DUZ,XMMG=$S($D(^VA(200,DUZ,0)):$P(^(0),U,1),1:"") D DES^XMA21
- Q
- ;
- SEND ;send 2507 AMIS report in bulletin
- N DVBAXMY M DVBAXMY=XMY
- S XMSUB="RO AMIS 290 Report "_$S((($G(DVBAPREXM)]"")&($G(DVBAPREXM)'="ALL")):"("_$G(DVBAPREXM)_" Exam Priority) ",1:"")_"- "
- S Y=BDATE1 X ^DD("DD") S XMSUB=XMSUB_Y S Y=EDATE1 X ^DD("DD") S XMSUB=XMSUB_" to "_Y,XMTEXT="^TMP($J,"
- D ^XMD K XMTEXT,XMSUB K ^TMP($J)
- I '$D(ZTSK) W !!,*7,">>> Mail message transmitted. <<<",!! H 2
- M XMY=DVBAXMY ;restore address list for subsequent bulletins
- Q
- ;
- HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF
- W "Regional Office AMIS 290 Report for C&P Examinations",?(IOM-9),"Page: ",PG,!
- W $$PRHD^DVBCIUTL(DVBAPREXM),!
- W "For date range: " S Y=BDATE1 X ^DD("DD") W Y W " to " S Y=EDATE1 X ^DD("DD") W Y,!
- F LINE=1:1:80 W "-"
- W !!
- Q
- ;
- PAUSE N ANS K DVBAOUT S ANS="" I IOST?1"C-".E W *7,!!,"Press RETURN to continue or ""^"" to exit " R ANS:DTIME I '$T!(ANS[U) S DVBAOUT=1
- Q
- ;
- ;Input : DVBACDE - Priority of Exam code to get Totals for
- ; : DVBATOT - Array holding total values for each specific priority
- ; (By Ref)
- ; : TOT - array to hold totals for requested priority (By Ref)
- ;Output: TOT array with totals for requested priority
- CRTOT(DVBACDE,DVBATOT,TOT) ;create total array for specific priority exam report
- N JI K TOT
- F JI="3DAYSCH","30DAYEX","PENDADJ" D
- .S TOT(JI)=$G(DVBATOT(DVBACDE,JI))
- F JI="INSUFF","SENT","INCOMPLETE","DAYS","COMPLETED" D
- .S TOT(JI)=$G(DVBATOT(DVBACDE,JI))
- F JI="P90","P121","P151","P181","P365","P366" D
- .S TOT(JI)=$G(DVBATOT(DVBACDE,JI))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCAMR2 6371 printed Feb 18, 2025@23:09:55 Page 2
- DVBCAMR2 ;ALB/GTS-557/THM-REGIONAL OFFICE AMIS 290 REPORT, CALCULATIONS ; 9/28/91 6:43 AM
- +1 ;;2.7;AMIE;**149,184**;Apr 10, 1995;Build 10
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;** Version Changes
- +5 ; 2.7 - GTS/Coded to adjust 35 day clock calc (Enhc 13)
- +6 ;
- DAY30 ;exam completion
- +1 NEW DVBADTS,DVBAPPTS,DVBACNT,DVBADTM,DVBANDE,X,X1,X2
- +2 KILL ^TMP("DVBC",$JOB),^TMP($JOB,"SDAMA301")
- +3 ;DES Type exams required to be completed in 45 days, all others 30
- +4 SET DVBADTS=$SELECT(((";IDES;")[(";"_DVBAPREXM_";")):45,1:30)
- +5 ;setup call to scheduling API
- +6 SET DVBAPPTS(1)=DTRPT_";"_EDATE
- SET DVBAPPTS(4)=PNAM
- SET DVBAPPTS(3)="R;I;NT"
- +7 SET DVBAPPTS("SORT")="P"
- SET DVBAPPTS("FLDS")="10"
- +8 SET DVBACNT=$$SDAPI^SDAMA301(.DVBAPPTS)
- +9 IF (DVBACNT'>0)
- KILL ^TMP($JOB,"SDAMA301")
- QUIT
- +10 SET DVBADTM=""
- +11 FOR
- SET DVBADTM=$ORDER(^TMP($JOB,"SDAMA301",PNAM,DVBADTM))
- if ('+DVBADTM)
- QUIT
- Begin DoDot:1
- +12 SET ^TMP("DVBC",$JOB,9999999-DVBADTM,DVBADTM)=""
- End DoDot:1
- +13 SET DVBANDE=$ORDER(^TMP("DVBC",$JOB,0))
- SET DVBADTM=$ORDER(^TMP("DVBC",$JOB,DVBANDE,0))
- +14 if (DVBADTM]"")
- Begin DoDot:1
- +15 SET X2=DVBADTM
- SET X1=$SELECT(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW)
- +16 ;calculate date diff
- DO ^%DTC
- +17 if (X>DVBADTS)
- SET TOT(DVBAPREXM,"30DAYEX")=TOT(DVBAPREXM,"30DAYEX")+1
- End DoDot:1
- +18 KILL ^TMP($JOB,"SDAMA301")
- +19 QUIT
- +20 ;
- PENDCNT IF X'<0&(X'>90)
- SET TOT(DVBAPREXM,"P90")=TOT(DVBAPREXM,"P90")+1
- +1 IF X>90&(X'>120)
- SET TOT(DVBAPREXM,"P121")=TOT(DVBAPREXM,"P121")+1
- +2 IF X>120&(X'>150)
- SET TOT(DVBAPREXM,"P151")=TOT(DVBAPREXM,"P151")+1
- +3 IF X>150&(X'>180)
- SET TOT(DVBAPREXM,"P181")=TOT(DVBAPREXM,"P181")+1
- +4 IF X>180&(X'>365)
- SET TOT(DVBAPREXM,"P365")=TOT(DVBAPREXM,"P365")+1
- +5 IF X>365
- SET TOT(DVBAPREXM,"P366")=TOT(DVBAPREXM,"P366")+1
- +6 QUIT
- +7 ;
- SET ;
- +1 NEW DVBAPREXM
- +2 SET DTA=^DVB(396.3,REQDA,0)
- SET DTREQ=$PIECE(DTA,U,2)
- SET XRONUM=$PIECE(DTA,U,3)
- SET XRONUM=$SELECT($DATA(^DIC(4,+XRONUM,99)):$PIECE(^(99),U,1),1:0)
- if XRONUM'=RONUM&(RONUM'="ALL")
- QUIT
- +3 KILL XRONUM
- SET DTRPT=$PIECE(DTA,U,5)
- SET DTSCHEDC=$PIECE(DTA,U,6)
- SET DTRQCMP=$PIECE(DTA,U,7)
- SET DTTRANS=$PIECE(DTA,U,12)
- SET DTREL=$PIECE(DTA,U,14)
- SET RQSTAT=$PIECE(DTA,U,18)
- SET DTCAN=$PIECE(DTA,U,19)
- SET PRIO=$PIECE(DTA,U,10)
- KILL DTA
- +4 IF DTRPT=""
- IF DTCAN]""
- SET DTRPT=DTCAN
- +5 ;requests never printed
- if DTRPT=""
- QUIT
- +6 ;check for Parent Request (retrieve current/parent Priority of Exam)
- +7 SET DVBAPREXM=$$CHKREQ^DVBCIRP1(REQDA)
- +8 ;original report run (Exclude new priorities)
- +9 if ((DVBAEXMP']"")&((";BDD;QS;IDES;AO;")[(";"_DVBAPREXM_";")))
- QUIT
- +10 ;report for specific priority
- +11 if ((DVBAEXMP]"")&(DVBAEXMP'[(";"_DVBAPREXM_";")))
- QUIT
- +12 ;identifier for totals
- if (DVBAEXMP']"")
- SET DVBAPREXM="ALL"
- +13 IF DTREL'<BDATE
- IF DTREL'>EDATE
- DO DAY30
- +14 IF DTRPT'<BDATE
- IF DTRPT'>EDATE
- SET TOT(DVBAPREXM,"SENT")=TOT(DVBAPREXM,"SENT")+1
- +15 IF DTRPT'<BDATE
- IF DTRPT'>EDATE
- IF RQSTAT'["X"
- SET X1=$SELECT(DTSCHEDC]"":DTSCHEDC,1:DVBCNOW)
- SET X2=DTRPT
- DO ^%DTC
- IF X>3
- SET TOT(DVBAPREXM,"3DAYSCH")=TOT(DVBAPREXM,"3DAYSCH")+1
- +16 IF DTREL'<BDATE&(DTREL'>EDATE)
- IF RQSTAT="C"!(RQSTAT="R")
- if PRIO'="E"
- SET DVBCPCTM=$$PROCDAY^DVBCUTL2(REQDA)
- if PRIO="E"
- SET DVBCPCTM=$$INSFTME^DVBCUTA1(REQDA)
- SET TOT(DVBAPREXM,"DAYS")=TOT(DVBAPREXM,"DAYS")+DVBCPCTM
- KILL DVBCPCTM
- +17 IF DTRPT'>EDATE
- IF "^P^S^T"[RQSTAT
- SET TOT(DVBAPREXM,"PENDADJ")=TOT(DVBAPREXM,"PENDADJ")+1
- SET X1=EDATE
- SET X2=DTRPT
- DO ^%DTC
- DO PENDCNT
- +18 IF DTRPT'>EDATE
- IF "^C^CT^R^RX^X^"[RQSTAT
- IF (+DTREL>EDATE)!(+DTCAN>EDATE)
- SET TOT(DVBAPREXM,"PENDADJ")=TOT(DVBAPREXM,"PENDADJ")+1
- SET X1=EDATE
- SET X2=DTRPT
- DO ^%DTC
- DO PENDCNT
- +19 IF DTREL'<BDATE&(DTREL'>EDATE)
- IF RQSTAT["C"!(RQSTAT="R")
- SET TOT(DVBAPREXM,"COMPLETED")=TOT(DVBAPREXM,"COMPLETED")+1
- +20 IF DTRPT'<BDATE
- IF DTRPT'>EDATE
- IF PRIO="E"
- SET TOT(DVBAPREXM,"INSUFF")=TOT(DVBAPREXM,"INSUFF")+1
- +21 IF DTCAN'<BDATE&(DTCAN'>EDATE)
- IF RQSTAT="X"!(RQSTAT="RX")
- SET TOT(DVBAPREXM,"INCOMPLETE")=TOT(DVBAPREXM,"INCOMPLETE")+1
- +22 KILL DTRPT
- QUIT
- +23 ;
- GO ;
- +1 NEW DVBAEXMP,DVBAP,DVBAPREXM,DVBATOT,DVBAOUT,PG
- +2 SET PG=0
- +3 SET DVBAEXMP=$SELECT($GET(DVBAPRTY)["BDD":";BDD;QS;",($GET(DVBAPRTY)["IDES"):";IDES;",($GET(DVBAPRTY)["AO"):";AO;",1:"")
- +4 SET %DT="TS"
- SET X="NOW"
- DO ^%DT
- SET DVBCNOW=Y
- KILL ^TMP($JOB)
- +5 SET PNAM=""
- FOR JJ=0:0
- SET PNAM=$ORDER(^DVB(396.3,"B",PNAM))
- if PNAM=""
- QUIT
- FOR REQDA=0:0
- SET REQDA=$ORDER(^DVB(396.3,"B",PNAM,REQDA))
- if REQDA=""
- QUIT
- DO SET
- +6 ;
- +7 SET DVBAEXMP=$SELECT($GET(DVBAPRTY)["BDD":"BDD,QS",($GET(DVBAPRTY)["IDES"):"IDES",($GET(DVBAPRTY)["AO"):"AO",1:"ALL")
- +8 ;save totals for all priorities into new array
- MERGE DVBATOT=TOT
- +9 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
- Begin DoDot:1
- +10 KILL DVBAOUT
- SET DVBAPREXM=$PIECE(DVBAEXMP,",",DVBAP)
- +11 ;re-create TOT array for each priority of exam
- +12 DO CRTOT(DVBAPREXM,.DVBATOT,.TOT)
- +13 SET TOT("AVGDAYS")=0
- +14 IF TOT("COMPLETED")>0
- SET TOT("AVGDAYS")=TOT("DAYS")/TOT("COMPLETED")
- SET TOT("AVGDAYS")=$JUSTIFY(TOT("AVGDAYS"),5,1)
- +15 DO BULLTXT^DVBCAMR1(DVBAPREXM)
- +16 USE IO
- DO HDR
- FOR JI=0.9:0
- SET JI=$ORDER(^TMP($JOB,JI))
- if JI=""
- QUIT
- WRITE ^(JI,0),!
- IF IOST?1"C-".E
- IF $Y>19
- DO PAUSE
- if $DATA(DVBAOUT)
- GOTO EXIT
- DO HDR
- +17 DO PAUSE
- IF $DATA(DVBAOUT)
- if SBULL="Y"
- WRITE !!,*7,"Bulletin will NOT be sent!!",*7,!
- HANG 2
- GOTO EXIT
- +18 if '$DATA(XMY)
- SET SBULL="N"
- IF SBULL="Y"
- DO SEND
- End DoDot:1
- +19 DO ^%ZISC
- +20 ;
- EXIT ;
- +1 ;another report to run
- if (DVBAP'=$LENGTH(DVBAEXMP,","))
- QUIT
- +2 if $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- KILL PREVMO,UPDATE,XMY
- GOTO KILL^DVBCUTIL
- +3 ;
- BULL WRITE !
- SET XMDUZ=DUZ
- SET XMMG=$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U,1),1:"")
- DO DES^XMA21
- +1 QUIT
- +2 ;
- SEND ;send 2507 AMIS report in bulletin
- +1 NEW DVBAXMY
- MERGE DVBAXMY=XMY
- +2 SET XMSUB="RO AMIS 290 Report "_$SELECT((($GET(DVBAPREXM)]"")&($GET(DVBAPREXM)'="ALL")):"("_$GET(DVBAPREXM)_" Exam Priority) ",1:"")_"- "
- +3 SET Y=BDATE1
- XECUTE ^DD("DD")
- SET XMSUB=XMSUB_Y
- SET Y=EDATE1
- XECUTE ^DD("DD")
- SET XMSUB=XMSUB_" to "_Y
- SET XMTEXT="^TMP($J,"
- +4 DO ^XMD
- KILL XMTEXT,XMSUB
- KILL ^TMP($JOB)
- +5 IF '$DATA(ZTSK)
- WRITE !!,*7,">>> Mail message transmitted. <<<",!!
- HANG 2
- +6 ;restore address list for subsequent bulletins
- MERGE XMY=DVBAXMY
- +7 QUIT
- +8 ;
- HDR SET PG=PG+1
- if (IOST?1"C-".E)
- WRITE @IOF
- +1 WRITE "Regional Office AMIS 290 Report for C&P Examinations",?(IOM-9),"Page: ",PG,!
- +2 WRITE $$PRHD^DVBCIUTL(DVBAPREXM),!
- +3 WRITE "For date range: "
- SET Y=BDATE1
- XECUTE ^DD("DD")
- WRITE Y
- WRITE " to "
- SET Y=EDATE1
- XECUTE ^DD("DD")
- WRITE Y,!
- +4 FOR LINE=1:1:80
- WRITE "-"
- +5 WRITE !!
- +6 QUIT
- +7 ;
- PAUSE NEW ANS
- KILL DVBAOUT
- SET ANS=""
- IF IOST?1"C-".E
- WRITE *7,!!,"Press RETURN to continue or ""^"" to exit "
- READ ANS:DTIME
- IF '$TEST!(ANS[U)
- SET DVBAOUT=1
- +1 QUIT
- +2 ;
- +3 ;Input : DVBACDE - Priority of Exam code to get Totals for
- +4 ; : DVBATOT - Array holding total values for each specific priority
- +5 ; (By Ref)
- +6 ; : TOT - array to hold totals for requested priority (By Ref)
- +7 ;Output: TOT array with totals for requested priority
- CRTOT(DVBACDE,DVBATOT,TOT) ;create total array for specific priority exam report
- +1 NEW JI
- KILL TOT
- +2 FOR JI="3DAYSCH","30DAYEX","PENDADJ"
- Begin DoDot:1
- +3 SET TOT(JI)=$GET(DVBATOT(DVBACDE,JI))
- End DoDot:1
- +4 FOR JI="INSUFF","SENT","INCOMPLETE","DAYS","COMPLETED"
- Begin DoDot:1
- +5 SET TOT(JI)=$GET(DVBATOT(DVBACDE,JI))
- End DoDot:1
- +6 FOR JI="P90","P121","P151","P181","P365","P366"
- Begin DoDot:1
- +7 SET TOT(JI)=$GET(DVBATOT(DVBACDE,JI))
- End DoDot:1
- +8 QUIT