APCLOSUT.m

APCLOSUT ; IHS/CMI/LAB - PRINTING UTILITIES ;

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

 ;

XTMP(N,D) ;EP - set xtmp 0 node

 Q:$G(N)=""

 S ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$G(D)

 Q

CALC ;ENTRY POINT

 I (+Y=0)!(+X=0) S Z="**" G COMMA ;IHS/CMI/LAB - fixed per ANMC

 S Z=(((X/Y)-1)*100),Z=$FN(Z,"+,",1)

COMMA ;

 S X=$FN(X,",")

 ;S X2=0,X3=$S($L(X)>3:($L(X)+($L(X)\3)),1:$L(X)) D COMMA^%DTC S X=$E(X,1,($L(X)-1))

 Q

DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY

 I $D(APCLET) S APCLTS=(86400*($P(APCLET,",")-$P(APCLBT,",")))+($P(APCLET,",",2)-$P(APCLBT,",",2)),APCLH=$P(APCLTS/3600,".") S:APCLH="" APCLH=0 D

 .S APCLTS=APCLTS-(APCLH*3600),APCLM=$P(APCLTS/60,".") S:APCLM="" APCLM=0 S APCLTS=APCLTS-(APCLM*60),APCLS=APCLTS W !!,"RUN TIME (H.M.S): ",APCLH,".",APCLM,".",APCLS

 I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 ;W:$D(IOF) @IOF

 K APCLTS,APCLS,APCLH,APCLM,APCLET

 Q

SET ;ENTRY POINT

 S APCL1="AMBPOVC",APCL3="AMBPOV" D SET1

 S APCL1="AMBAPCC",APCL3="AMBAPC" D SET1

 S APCL1="AMBINJCAUSEC",APCL3="AMBINJCAUSE" D SET1

 S APCL1="DENTPOVC",APCL3="DENTPOV" D SET1

 S APCL1="AMBPROVC",APCL3="AMBPROV" D SET1

 S APCL1="AMBTYPEC",APCL3="AMBTYPE" D SET1

 S APCL1="AMBCATC",APCL3="AMBCAT" D SET1

 S APCL1="AMBCLINC",APCL3="AMBCLIN" D SET1

 S APCL1="AMBLOCC",APCL3="AMBLOC" D SET1

 Q

SET1 S APCL2="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"""_APCL3_""",X)"

 S X="" F  S X=$O(@APCL2) Q:X=""  S %=^(X) S ^XTMP(APCLOS,APCLJOB,APCLBTH,APCL1,9999999-%,X)=%

 Q

EOJ ;ENTRY POINT

 K %DT,DFN,Y,X,C,DIRUT,DIR,J,H,X1,X2,X3

 K APCLFYEY,APCLFYE,APCLFYBE,APCLFYB,APCLDTP,APCLMFY,APCLMON,APCLSU,APCLSUF,APCLLOCT,APCLTYPE,APCL,APCLFYBY,APCLRPT,APCLJ,APCLOS,APCLPYB,APCLPYE,APCLQUIT,APCLSQ,APCLP,APCLDIC,APCLDICB,APCLLOC,APCLFY,APCLNBC,APCLNBCD,APCLNBDY

 K APCLBT,APCLJOB,APCLERR,APCLACED,APCLRD

 Q

APCLOSUT  ; IHS/CMI/LAB - PRINTING UTILITIES ;

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

 +2       ;

XTMP(N,D) ;EP - set xtmp 0 node

 +1        IF $GET(N)=""

               QUIT 

 +2        SET ^XTMP(N,0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_$GET(D)

 +3        QUIT 

CALC      ;ENTRY POINT

 +1       ;IHS/CMI/LAB - fixed per ANMC

           IF (+Y=0)!(+X=0)

               SET Z="**"

               GOTO COMMA

 +2        SET Z=(((X/Y)-1)*100)

           SET Z=$FNUMBER(Z,"+,",1)

COMMA     ;

 +1        SET X=$FNUMBER(X,",")

 +2       ;S X2=0,X3=$S($L(X)>3:($L(X)+($L(X)\3)),1:$L(X)) D COMMA^%DTC S X=$E(X,1,($L(X)-1))

 +3        QUIT 

DONE      ;ENTRY POINT - END OF REPORT TIME DISPLAY

 +1        IF $DATA(APCLET)

               SET APCLTS=(86400*($PIECE(APCLET,",")-$PIECE(APCLBT,",")))+($PIECE(APCLET,",",2)-$PIECE(APCLBT,",",2))

               SET APCLH=$PIECE(APCLTS/3600,".")

               IF APCLH=""

                   SET APCLH=0

               Begin DoDot:1

 +2                SET APCLTS=APCLTS-(APCLH*3600)

                   SET APCLM=$PIECE(APCLTS/60,".")

                   IF APCLM=""

                       SET APCLM=0

                   SET APCLTS=APCLTS-(APCLM*60)

                   SET APCLS=APCLTS

                   WRITE !!,"RUN TIME (H.M.S): ",APCLH,".",APCLM,".",APCLS

               End DoDot:1

 +3        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   SET DIR(0)="EO"

                   SET DIR("A")="End of report.  HIT RETURN"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +4       ;W:$D(IOF) @IOF

 +5        KILL APCLTS,APCLS,APCLH,APCLM,APCLET

 +6        QUIT 

SET       ;ENTRY POINT

 +1        SET APCL1="AMBPOVC"

           SET APCL3="AMBPOV"

           DO SET1

 +2        SET APCL1="AMBAPCC"

           SET APCL3="AMBAPC"

           DO SET1

 +3        SET APCL1="AMBINJCAUSEC"

           SET APCL3="AMBINJCAUSE"

           DO SET1

 +4        SET APCL1="DENTPOVC"

           SET APCL3="DENTPOV"

           DO SET1

 +5        SET APCL1="AMBPROVC"

           SET APCL3="AMBPROV"

           DO SET1

 +6        SET APCL1="AMBTYPEC"

           SET APCL3="AMBTYPE"

           DO SET1

 +7        SET APCL1="AMBCATC"

           SET APCL3="AMBCAT"

           DO SET1

 +8        SET APCL1="AMBCLINC"

           SET APCL3="AMBCLIN"

           DO SET1

 +9        SET APCL1="AMBLOCC"

           SET APCL3="AMBLOC"

           DO SET1

 +10       QUIT 

SET1       SET APCL2="^XTMP("""_APCLOS_""",APCLJOB,APCLBTH,"""_APCL3_""",X)"

 +1        SET X=""

           FOR 

               SET X=$ORDER(@APCL2)

               IF X=""

                   QUIT 

               SET %=^(X)

               SET ^XTMP(APCLOS,APCLJOB,APCLBTH,APCL1,9999999-%,X)=%

 +2        QUIT 

EOJ       ;ENTRY POINT

 +1        KILL %DT,DFN,Y,X,C,DIRUT,DIR,J,H,X1,X2,X3

 +2        KILL APCLFYEY,APCLFYE,APCLFYBE,APCLFYB,APCLDTP,APCLMFY,APCLMON,APCLSU,APCLSUF,APCLLOCT,APCLTYPE,APCL,APCLFYBY,APCLRPT,APCLJ,APCLOS,APCLPYB,APCLPYE,APCLQUIT,APCLSQ,APCLP,APCLDIC,APCLDICB,APCLLOC,APCLFY,APCLNBC,APCLNBCD,APCLNBDY

 +3        KILL APCLBT,APCLJOB,APCLERR,APCLACED,APCLRD

 +4        QUIT