ACHSOCSP ; IHS/ITSC/PMF - PRINT CHS SERVICE CLASS CODES SUMMARY ; [ 10/12/2004 12:50 PM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,7**;JUNE 11,2001
;ACHS*3.1*6 IHS/SET/JVK ADD TOTALS TO SHOW OBLIGTED TO PAID SUMMARY
;ACHS*3.1*7 IHS/SET/JVK ADD PAID TOTALS FOR NUMBER OF DOC'S
;
D BRPT^ACHSFU
S (ACHSOB,ACHSPAY,ACHSDOC)=0,ACHSBM=IOSL-4
S (ACHSPAGE,ACHSOBST,ACHSPMS,ACHSDOCS,ACHSOBT,ACHSPMTT,ACHSDOCT,ACHSDOC,ACHSOB,ACHSPMT,ACHSPMST,ACHSDST,ACHSOBS,ACHSOBT,ACHSWKLD,ACHSWKTO)=0
I '$D(^TMP("ACHSOCSQ",$J)) D NODATA G END
S ACHSFAC=""
P1 ;
S ACHSFAC=$O(^TMP("ACHSOCSQ",$J,ACHSFAC))
G:ACHSFAC="" TOTAL
D HEADER,HEADER1
S ACHSOC=""
P1A ;
S ACHSOC=$O(^TMP("ACHSOCSQ",$J,ACHSFAC,ACHSOC))
I ACHSOC="" D SUBTOTL G P1
S ACHSOCD=$E($P(ACHSOC,U,1),1,2)_"."_$E($P(ACHSOC,U,1),3,99)_$$REPEAT^XLFSTR(" ",30)
S X=$G(^TMP("ACHSOCSQ",$J,ACHSFAC,ACHSOC))
S ACHSDOCS=$P(X,U,1)
S ACHSOBS=$P(X,U,2)
S ACHSPMS=$P(X,U,3)
S ACHSWKL=$P(X,U,4)
;ITSC/SET/JVK ACHS*3.1*7 ADD DOCS PAID VS TOTAL DOCS
S ACHSPDOC=$P(X,U,5)
S ACHSBLKT=$P(X,U,6)
I ACHSBLKT="" S ACHSBLKT=0
W !,$E(ACHSOCD,1,30),$J($FN(ACHSDOCS,","),10),$J($FN(ACHSOBS,",",2),16),$J($FN(ACHSPMS,",",2),16),$J($FN(ACHSWKL,","),8)
;ITSC/SET/JVK ACHS*3.1.*7 ADD TOTAL OF PAID DOCS TO PRINT LINE
W !,?12,"Paid Doc(s)",?30,$J(ACHSPDOC,10),?45,"Blankets/Special Doc(s): ",ACHSBLKT,!
S ACHSOBST=ACHSOBST+ACHSOBS,ACHSPMST=ACHSPMST+ACHSPMS,ACHSDST=ACHSDST+ACHSDOCS,ACHSWKLD=ACHSWKLD+ACHSWKL
I $Y>ACHSBM D RTRN^ACHS G:$G(ACHSQUIT) END Q:'$D(ACHSPAGE) D HEADER,HEADER1
G P1A
;
SUBTOTL ;
W !!,$$REPEAT^XLFSTR("-",80),!,"SUBTOTAL",$$REPEAT^XLFSTR(" ",22),$J($FN(ACHSDST,","),10),$J("$"_$FN(ACHSOBST,",",2),16),$J("$"_$FN(ACHSPMST,",",2),16),$J($FN(ACHSWKLD,","),8)
;IHS/SET/JVK ACHS*3.1*6 BEG NEW CODE
;I ACHSOBST>0,ACHSPMST>0 S X=(ACHSPMST/ACHSOBST)*100 W !!,"PERCENTAGE OF PAYMENT TO OBLIGATED",?54,$J($FN(X,",",2),8),"%"
I ACHSOBST>0,ACHSPMST>0 S X=(ACHSPMST/ACHSOBST)*100 W !!,"PERCENTAGE OF POSTED PAYMENTS TO OBLIGATED",?54,$J($FN(X,",",2),8),"%"
W !!,"OBLIGATED PAYMENT RECONCILE AMT",?45,$J($FN(ACHSOBX,",",2),10)
W !!,"PAYMENT ADJUSTMENT RECONCILE AMT",?45,$J($FN(ACHSZAT,",",2),10)
;S ACHSOBT=ACHSOBT+ACHSOBST,ACHSPMTT=ACHSPMTT+ACHSPMST,ACHSDOCT=ACHSDOCT+ACHSDST,ACHSWKTO=ACHSWKTO+ACHSWKLD
S ACHSOBT=ACHSOBT+ACHSOBST+ACHSOBX+ACHSZAT,ACHSPMTT=ACHSPMTT+ACHSPMST,ACHSDOCT=ACHSDOCT+ACHSDST,ACHSWKTO=ACHSWKTO+ACHSWKLD
;IHS/SET/JVK ACHS*3.1*6 END NEW CODE
S (ACHSOBST,ACHSPMST,ACHSDST,ACHSPAGE,ACHSWKLD)=0
Q
;
TOTAL ;
W !!!!,$$REPEAT^XLFSTR("=",80),!!,"TOTAL",$$REPEAT^XLFSTR(" ",25),$J($FN(ACHSDOCT,","),10),$J("$"_$FN(ACHSOBT,",",2),16),$J("$"_$FN(ACHSPMTT,",",2),16),$J($FN(ACHSWKTO,","),8),!
I ACHSOBT>0,ACHSPMTT>0 S Z=(ACHSPMTT/ACHSOBT)*100 W !,"PERCENTAGE OF PAYMENT TO TOTAL OBLIGATED",?54,$J($FN(Z,",",2),8),"%"
;ITSC/SET/JVK ACHS*3.1*7 ADD LINE BELOW
W !!,"TOTAL DOCUMENTS IN PAID STATUS: ",?20,$J(ACHSPSCC,10)
D RTRN^ACHS
END ;Close device, kill variables, quit
S:$D(ZTQUEUED) ZTREQ="@"
D ERPT^ACHS,EN^XBVK("ACHS"),^ACHSVAR
K I,X
K ^TMP("ACHSOCSQ",$J),X2,Z,DIR
Q
;
NODATA ;
D HEADER
W !!!,"NO DATA FOR SPECIFIED ",$S(ACHSFY:"FISCAL YEAR",1:"DATES"),".",!!!!
D RTRN^ACHS
Q
;
W @IOF
S ACHSPAGE=ACHSPAGE+1
S Y=$$HTE^XLFDT($H),ACHSTIM=$P(Y,"@",2)
W !,"*",$P(Y,"@",1)
S X=$$LOC^ACHS W ?((80/2)-($L(X)/2)),X
W ?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*",!!
S X="SERVICE CLASSIFICATION Summary Report - Page "
W ?((80/2)-($L(X)/2)),X_ACHSPAGE,!
S X=$S(ACHSFY:"For FISCAL YEAR: "_ACHSFY,1:"From "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT))
W ?((80/2)-($L(X)/2)),X,!,$$REPEAT^XLFSTR("*",80)
Q
;
W !!,"OBJCODE",?32,"#_DOCS_#",?46,"$_OBLIGD_$",?61,"$_PAYMENT_$ WORKLD"
Q
;
ACHSOCSP ; IHS/ITSC/PMF - PRINT CHS SERVICE CLASS CODES SUMMARY ; [ 10/12/2004 12:50 PM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,7**;JUNE 11,2001
+2 ;ACHS*3.1*6 IHS/SET/JVK ADD TOTALS TO SHOW OBLIGTED TO PAID SUMMARY
+3 ;ACHS*3.1*7 IHS/SET/JVK ADD PAID TOTALS FOR NUMBER OF DOC'S
+4 ;
+5 DO BRPT^ACHSFU
+6 SET (ACHSOB,ACHSPAY,ACHSDOC)=0
SET ACHSBM=IOSL-4
+7 SET (ACHSPAGE,ACHSOBST,ACHSPMS,ACHSDOCS,ACHSOBT,ACHSPMTT,ACHSDOCT,ACHSDOC,ACHSOB,ACHSPMT,ACHSPMST,ACHSDST,ACHSOBS,ACHSOBT,ACHSWKLD,ACHSWKTO)=0
+8 IF '$DATA(^TMP("ACHSOCSQ",$JOB))
DO NODATA
GOTO END
+9 SET ACHSFAC=""
P1 ;
+1 SET ACHSFAC=$ORDER(^TMP("ACHSOCSQ",$JOB,ACHSFAC))
+2 IF ACHSFAC=""
GOTO TOTAL
+3 DO HEADER
DO HEADER1
+4 SET ACHSOC=""
P1A ;
+1 SET ACHSOC=$ORDER(^TMP("ACHSOCSQ",$JOB,ACHSFAC,ACHSOC))
+2 IF ACHSOC=""
DO SUBTOTL
GOTO P1
+3 SET ACHSOCD=$EXTRACT($PIECE(ACHSOC,U,1),1,2)_"."_$EXTRACT($PIECE(ACHSOC,U,1),3,99)_$$REPEAT^XLFSTR(" ",30)
+4 SET X=$GET(^TMP("ACHSOCSQ",$JOB,ACHSFAC,ACHSOC))
+5 SET ACHSDOCS=$PIECE(X,U,1)
+6 SET ACHSOBS=$PIECE(X,U,2)
+7 SET ACHSPMS=$PIECE(X,U,3)
+8 SET ACHSWKL=$PIECE(X,U,4)
+9 ;ITSC/SET/JVK ACHS*3.1*7 ADD DOCS PAID VS TOTAL DOCS
+10 SET ACHSPDOC=$PIECE(X,U,5)
+11 SET ACHSBLKT=$PIECE(X,U,6)
+12 IF ACHSBLKT=""
SET ACHSBLKT=0
+13 WRITE !,$EXTRACT(ACHSOCD,1,30),$JUSTIFY($FNUMBER(ACHSDOCS,","),10),$JUSTIFY($FNUMBER(ACHSOBS,",",2),16),$JUSTIFY($FNUMBER(ACHSPMS,",",2),16),$JUSTIFY($FNUMBER(ACHSWKL,","),8)
+14 ;ITSC/SET/JVK ACHS*3.1.*7 ADD TOTAL OF PAID DOCS TO PRINT LINE
+15 WRITE !,?12,"Paid Doc(s)",?30,$JUSTIFY(ACHSPDOC,10),?45,"Blankets/Special Doc(s): ",ACHSBLKT,!
+16 SET ACHSOBST=ACHSOBST+ACHSOBS
SET ACHSPMST=ACHSPMST+ACHSPMS
SET ACHSDST=ACHSDST+ACHSDOCS
SET ACHSWKLD=ACHSWKLD+ACHSWKL
+17 IF $Y>ACHSBM
DO RTRN^ACHS
IF $GET(ACHSQUIT)
GOTO END
IF '$DATA(ACHSPAGE)
QUIT
DO HEADER
DO HEADER1
+18 GOTO P1A
+19 ;
SUBTOTL ;
+1 WRITE !!,$$REPEAT^XLFSTR("-",80),!,"SUBTOTAL",$$REPEAT^XLFSTR(" ",22),$JUSTIFY($FNUMBER(ACHSDST,","),10),$JUSTIFY("$"_$FNUMBER(ACHSOBST,",",2),16),$JUSTIFY("$"_$FNUMBER(ACHSPMST,",",2),16),$JUSTIFY($FNUMBER(ACHSWKLD,","),8)
+2 ;IHS/SET/JVK ACHS*3.1*6 BEG NEW CODE
+3 ;I ACHSOBST>0,ACHSPMST>0 S X=(ACHSPMST/ACHSOBST)*100 W !!,"PERCENTAGE OF PAYMENT TO OBLIGATED",?54,$J($FN(X,",",2),8),"%"
+4 IF ACHSOBST>0
IF ACHSPMST>0
SET X=(ACHSPMST/ACHSOBST)*100
WRITE !!,"PERCENTAGE OF POSTED PAYMENTS TO OBLIGATED",?54,$JUSTIFY($FNUMBER(X,",",2),8),"%"
+5 WRITE !!,"OBLIGATED PAYMENT RECONCILE AMT",?45,$JUSTIFY($FNUMBER(ACHSOBX,",",2),10)
+6 WRITE !!,"PAYMENT ADJUSTMENT RECONCILE AMT",?45,$JUSTIFY($FNUMBER(ACHSZAT,",",2),10)
+7 ;S ACHSOBT=ACHSOBT+ACHSOBST,ACHSPMTT=ACHSPMTT+ACHSPMST,ACHSDOCT=ACHSDOCT+ACHSDST,ACHSWKTO=ACHSWKTO+ACHSWKLD
+8 SET ACHSOBT=ACHSOBT+ACHSOBST+ACHSOBX+ACHSZAT
SET ACHSPMTT=ACHSPMTT+ACHSPMST
SET ACHSDOCT=ACHSDOCT+ACHSDST
SET ACHSWKTO=ACHSWKTO+ACHSWKLD
+9 ;IHS/SET/JVK ACHS*3.1*6 END NEW CODE
+10 SET (ACHSOBST,ACHSPMST,ACHSDST,ACHSPAGE,ACHSWKLD)=0
+11 QUIT
+12 ;
TOTAL ;
+1 WRITE !!!!,$$REPEAT^XLFSTR("=",80),!!,"TOTAL",$$REPEAT^XLFSTR(" ",25),$JUSTIFY($FNUMBER(ACHSDOCT,","),10),$JUSTIFY("$"_$FNUMBER(ACHSOBT,",",2),16),$JUSTIFY("$"_$FNUMBER(ACHSPMTT,",",2),16),$JUSTIFY($FNUMBER(ACHSWKTO,","),8),!
+2 IF ACHSOBT>0
IF ACHSPMTT>0
SET Z=(ACHSPMTT/ACHSOBT)*100
WRITE !,"PERCENTAGE OF PAYMENT TO TOTAL OBLIGATED",?54,$JUSTIFY($FNUMBER(Z,",",2),8),"%"
+3 ;ITSC/SET/JVK ACHS*3.1*7 ADD LINE BELOW
+4 WRITE !!,"TOTAL DOCUMENTS IN PAID STATUS: ",?20,$JUSTIFY(ACHSPSCC,10)
+5 DO RTRN^ACHS
END ;Close device, kill variables, quit
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ERPT^ACHS
DO EN^XBVK("ACHS")
DO ^ACHSVAR
+3 KILL I,X
+4 KILL ^TMP("ACHSOCSQ",$JOB),X2,Z,DIR
+5 QUIT
+6 ;
NODATA ;
+1 DO HEADER
+2 WRITE !!!,"NO DATA FOR SPECIFIED ",$SELECT(ACHSFY:"FISCAL YEAR",1:"DATES"),".",!!!!
+3 DO RTRN^ACHS
+4 QUIT
+5 ;
+1 WRITE @IOF
+2 SET ACHSPAGE=ACHSPAGE+1
+3 SET Y=$$HTE^XLFDT($HOROLOG)
SET ACHSTIM=$PIECE(Y,"@",2)
+4 WRITE !,"*",$PIECE(Y,"@",1)
+5 SET X=$$LOC^ACHS
WRITE ?((80/2)-($LENGTH(X)/2)),X
+6 WRITE ?71,ACHSTIM,"*",!,"*User: ",ACHSUSR,?70,"Device:",IO,"*",!!
+7 SET X="SERVICE CLASSIFICATION Summary Report - Page "
+8 WRITE ?((80/2)-($LENGTH(X)/2)),X_ACHSPAGE,!
+9 SET X=$SELECT(ACHSFY:"For FISCAL YEAR: "_ACHSFY,1:"From "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT))
+10 WRITE ?((80/2)-($LENGTH(X)/2)),X,!,$$REPEAT^XLFSTR("*",80)
+11 QUIT
+12 ;
+1 WRITE !!,"OBJCODE",?32,"#_DOCS_#",?46,"$_OBLIGD_$",?61,"$_PAYMENT_$ WORKLD"
+2 QUIT
+3 ;
