APCLOS1.m

APCLOS1 ; IHS/CMI/LAB - process operational summary ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;IHS/CMI/LAB - fixed setting of APCLFY to include $G

 ;CMI/TUCSON/LAB - patch 3 fix FY variable

 ;

START ;

 S APCLBT=$H

 K ^XTMP("APCLOS",APCLJOB,APCLBTH),^XTMP("APCLOSP",APCLJOB,APCLBTH)

 D XTMP^APCLOSUT("APCLOS","PCC OPERATIONS SUMMARY")

 D XTMP^APCLOSUT("APCLOSP","PCC OPERATION SUMMARY")

 ;S X1=APCLFYB,X2=-365 D C^%DTC

 ;I APCLMFY=2 S APCLPYB=X S X1=APCLFYE,X2=-365 D C^%DTC S APCLPYE=X

 ;I APCLMFY=1 S APCLPYB=$E(X,1,3)_$E(APCLFYB,4,7) S X1=APCLFYE,X2=-365 D C^%DTC S APCLPYE=$E(X,1,3)_$E(APCLFYE,4,7)

 I APCLMFY=2 S APCLPYB=($E(APCLFYB,1,3)-1)_$E(APCLFYB,4,7) S APCLPYE=($E(APCLFYE,1,3)-1)_$E(APCLFYE,4,7)

 I APCLMFY=3 S APCLPYB=($E(APCLFYB,1,3)-1)_$E(APCLFYB,4,7) S APCLPYE=($E(APCLFYE,1,3)-1)_$E(APCLFYE,4,7)

 I APCLMFY=1 S APCLPYB=($E(APCLFYB,1,3)-1)_$E(APCLFYB,4,7) S APCLPYE=($E(APCLFYE,1,3)-1)_$E(APCLFYE,4,7)

 ;beginning Y2K

 ;S APCLFY=$S($E(APCLFYE,4)=1:$E(APCLFYE,2,3)+1,1:$E(APCLFYE,2,3)) ;Y2000

 S APCLFY=$G(APCL("FY")) ;Y2000 ;PATCH 5 added $G

 ;end Y2K

 S APCLJ=0

PROC ;

 S APCLSEGN="" F APCLSQ=0:0 S APCLSEGN=$O(^APCLOST(APCLRPT,1,"B",APCLSEGN)) Q:APCLSEGN=""  D SEGMNT Q:$D(APCLSQIT)

 S APCLET=$H

 Q

SEGMNT ; PROCESS A SEGMENT TYPE

 S APCLSEGT=$O(^APCLOST(APCLRPT,1,"B",APCLSEGN,"")) S APCLSEGC=$P(^APCLOST(APCLRPT,1,APCLSEGT,0),U,2) S APCLP=$P(^APCLOSC(APCLSEGC,0),U,3),APCLSEGC=$P(^APCLOSC(APCLSEGC,0),U,2)

 D @($P(APCLSEGC,";")_U_$P(APCLSEGC,";",2))

 Q

 ;

APCLOS1   ; IHS/CMI/LAB - process operational summary ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;IHS/CMI/LAB - fixed setting of APCLFY to include $G

 +3       ;CMI/TUCSON/LAB - patch 3 fix FY variable

 +4       ;

START     ;

 +1        SET APCLBT=$HOROLOG

 +2        KILL ^XTMP("APCLOS",APCLJOB,APCLBTH),^XTMP("APCLOSP",APCLJOB,APCLBTH)

 +3        DO XTMP^APCLOSUT("APCLOS","PCC OPERATIONS SUMMARY")

 +4        DO XTMP^APCLOSUT("APCLOSP","PCC OPERATION SUMMARY")

 +5       ;S X1=APCLFYB,X2=-365 D C^%DTC

 +6       ;I APCLMFY=2 S APCLPYB=X S X1=APCLFYE,X2=-365 D C^%DTC S APCLPYE=X

 +7       ;I APCLMFY=1 S APCLPYB=$E(X,1,3)_$E(APCLFYB,4,7) S X1=APCLFYE,X2=-365 D C^%DTC S APCLPYE=$E(X,1,3)_$E(APCLFYE,4,7)

 +8        IF APCLMFY=2

               SET APCLPYB=($EXTRACT(APCLFYB,1,3)-1)_$EXTRACT(APCLFYB,4,7)

               SET APCLPYE=($EXTRACT(APCLFYE,1,3)-1)_$EXTRACT(APCLFYE,4,7)

 +9        IF APCLMFY=3

               SET APCLPYB=($EXTRACT(APCLFYB,1,3)-1)_$EXTRACT(APCLFYB,4,7)

               SET APCLPYE=($EXTRACT(APCLFYE,1,3)-1)_$EXTRACT(APCLFYE,4,7)

 +10       IF APCLMFY=1

               SET APCLPYB=($EXTRACT(APCLFYB,1,3)-1)_$EXTRACT(APCLFYB,4,7)

               SET APCLPYE=($EXTRACT(APCLFYE,1,3)-1)_$EXTRACT(APCLFYE,4,7)

 +11      ;beginning Y2K

 +12      ;S APCLFY=$S($E(APCLFYE,4)=1:$E(APCLFYE,2,3)+1,1:$E(APCLFYE,2,3)) ;Y2000

 +13      ;Y2000 ;PATCH 5 added $G

           SET APCLFY=$GET(APCL("FY"))

 +14      ;end Y2K

 +15       SET APCLJ=0

PROC      ;

 +1        SET APCLSEGN=""

           FOR APCLSQ=0:0

               SET APCLSEGN=$ORDER(^APCLOST(APCLRPT,1,"B",APCLSEGN))

               IF APCLSEGN=""

                   QUIT 

               DO SEGMNT

               IF $DATA(APCLSQIT)

                   QUIT 

 +2        SET APCLET=$HOROLOG

 +3        QUIT 

SEGMNT    ; PROCESS A SEGMENT TYPE

 +1        SET APCLSEGT=$ORDER(^APCLOST(APCLRPT,1,"B",APCLSEGN,""))

           SET APCLSEGC=$PIECE(^APCLOST(APCLRPT,1,APCLSEGT,0),U,2)

           SET APCLP=$PIECE(^APCLOSC(APCLSEGC,0),U,3)

           SET APCLSEGC=$PIECE(^APCLOSC(APCLSEGC,0),U,2)

 +2        DO @($PIECE(APCLSEGC,";")_U_$PIECE(APCLSEGC,";",2))

 +3        QUIT 

 +4       ;