ACHSOCSP.m

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

 ;

HEADER ;Prints heading

 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

 ;

HEADER1 ;

 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       ;

HEADER    ;Prints heading

 +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      ;

HEADER1   ;

 +1        WRITE !!,"OBJCODE",?32,"#_DOCS_#",?46,"$_OBLIGD_$",?61,"$_PAYMENT_$  WORKLD"

 +2        QUIT 

 +3       ;