BMCOSUT.m

BMCOSUT ; IHS/PHXAO/TMJ - PRINTING UTILITIES ;  

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;IHS/ITSC/FCJ ADDED NUMERIC DATE FORMAT FOR PRINTING

 ;

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,",")

 Q

DONE ;ENTRY POINT - END OF REPORT TIME DISPLAY

 I $D(BMCET) S BMCTS=(86400*($P(BMCET,",")-$P(BMCBT,",")))+($P(BMCET,",",2)-$P(BMCBT,",",2)),BMCH=$P(BMCTS/3600,".") S:BMCH="" BMCH=0 D

 .S BMCTS=BMCTS-(BMCH*3600),BMCM=$P(BMCTS/60,".")

 .S:BMCM="" BMCM=0 S BMCTS=BMCTS-(BMCM*60),BMCS=BMCTS

 .W !!,"RUN TIME (H.M.S): ",BMCH,".",BMCM,".",BMCS

 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 BMCTS,BMCS,BMCH,BMCM,BMCET

 Q

SET ;ENTRY POINT

 S BMC1="AMBPOVC",BMC3="AMBPOV" D SET1

 S BMC1="AMBAPCC",BMC3="AMBAPC" D SET1

 S BMC1="AMBINJCAUSEC",BMC3="AMBINJCAUSE" D SET1

 S BMC1="DENTPOVC",BMC3="DENTPOV" D SET1

 S BMC1="AMBPROVC",BMC3="AMBPROV" D SET1

 S BMC1="AMBTYPEC",BMC3="AMBTYPE" D SET1

 S BMC1="AMBCATC",BMC3="AMBCAT" D SET1

 S BMC1="AMBCLINC",BMC3="AMBCLIN" D SET1

 S BMC1="AMBLOCC",BMC3="AMBLOC" D SET1

 Q

SET1 S BMC2="^XTMP("""_BMCOS_""",BMCJOB,BMCBTH,"""_BMC3_""",X)"

 S X="" F  S X=$O(@BMC2) Q:X=""  S %=^(X) S ^XTMP(BMCOS,BMCJOB,BMCBTH,BMC1,9999999-%,X)=%

 Q

EOJ ;ENTRY POINT

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

 K BMCFYEY,BMCFYE,BMCFYBE,BMCFYB,BMCDTP,BMCMFY,BMCMON,BMCSU,BMCSUF,BMCLOCT,BMCTYPE,BMC,BMCFYBY,BMCRPT,BMCJ,BMCOS,BMCPYB,BMCPYE,BMCQUIT,BMCSQ,BMCP,BMCDIC,BMCDICB,BMCLOC,BMCFY,BMCNBC,BMCNBCD,BMCNBDY

 K BMCBT,BMCJOB,BMCERR,BMCACED,BMCRD

 Q

DT ;EP; NUMERIC DATE FORMAT FOR PRINTING 4 DIGIT YEAR

 S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$S($E(Y,1,3)>299:20_$E(Y,2,3),1:(19_$E(Y,2,3)))

 Q

DT1 ;EP; NUMERIC DATE FORMAT FOR PRINTING 2 DIGIT YEAR

 S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)

BMCOSUT   ; IHS/PHXAO/TMJ - PRINTING UTILITIES ;  

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;IHS/ITSC/FCJ ADDED NUMERIC DATE FORMAT FOR PRINTING

 +3       ;

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        QUIT 

DONE      ;ENTRY POINT - END OF REPORT TIME DISPLAY

 +1        IF $DATA(BMCET)

               SET BMCTS=(86400*($PIECE(BMCET,",")-$PIECE(BMCBT,",")))+($PIECE(BMCET,",",2)-$PIECE(BMCBT,",",2))

               SET BMCH=$PIECE(BMCTS/3600,".")

               IF BMCH=""

                   SET BMCH=0

               Begin DoDot:1

 +2                SET BMCTS=BMCTS-(BMCH*3600)

                   SET BMCM=$PIECE(BMCTS/60,".")

 +3                IF BMCM=""

                       SET BMCM=0

                   SET BMCTS=BMCTS-(BMCM*60)

                   SET BMCS=BMCTS

 +4                WRITE !!,"RUN TIME (H.M.S): ",BMCH,".",BMCM,".",BMCS

               End DoDot:1

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

 +6        IF $DATA(IOF)

               WRITE @IOF

 +7        KILL BMCTS,BMCS,BMCH,BMCM,BMCET

 +8        QUIT 

SET       ;ENTRY POINT

 +1        SET BMC1="AMBPOVC"

           SET BMC3="AMBPOV"

           DO SET1

 +2        SET BMC1="AMBAPCC"

           SET BMC3="AMBAPC"

           DO SET1

 +3        SET BMC1="AMBINJCAUSEC"

           SET BMC3="AMBINJCAUSE"

           DO SET1

 +4        SET BMC1="DENTPOVC"

           SET BMC3="DENTPOV"

           DO SET1

 +5        SET BMC1="AMBPROVC"

           SET BMC3="AMBPROV"

           DO SET1

 +6        SET BMC1="AMBTYPEC"

           SET BMC3="AMBTYPE"

           DO SET1

 +7        SET BMC1="AMBCATC"

           SET BMC3="AMBCAT"

           DO SET1

 +8        SET BMC1="AMBCLINC"

           SET BMC3="AMBCLIN"

           DO SET1

 +9        SET BMC1="AMBLOCC"

           SET BMC3="AMBLOC"

           DO SET1

 +10       QUIT 

SET1       SET BMC2="^XTMP("""_BMCOS_""",BMCJOB,BMCBTH,"""_BMC3_""",X)"

 +1        SET X=""

           FOR 

               SET X=$ORDER(@BMC2)

               IF X=""

                   QUIT 

               SET %=^(X)

               SET ^XTMP(BMCOS,BMCJOB,BMCBTH,BMC1,9999999-%,X)=%

 +2        QUIT 

EOJ       ;ENTRY POINT

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

 +2        KILL BMCFYEY,BMCFYE,BMCFYBE,BMCFYB,BMCDTP,BMCMFY,BMCMON,BMCSU,BMCSUF,BMCLOCT,BMCTYPE,BMC,BMCFYBY,BMCRPT,BMCJ,BMCOS,BMCPYB,BMCPYE,BMCQUIT,BMCSQ,BMCP,BMCDIC,BMCDICB,BMCLOC,BMCFY,BMCNBC,BMCNBCD,BMCNBDY

 +3        KILL BMCBT,BMCJOB,BMCERR,BMCACED,BMCRD

 +4        QUIT 

DT        ;EP; NUMERIC DATE FORMAT FOR PRINTING 4 DIGIT YEAR

 +1        SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$SELECT($EXTRACT(Y,1,3)>299:20_$EXTRACT(Y,2,3),1:(19_$EXTRACT(Y,2,3)))

 +2        QUIT 

DT1       ;EP; NUMERIC DATE FORMAT FOR PRINTING 2 DIGIT YEAR

 +1        SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)