source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOUTL.m@ 1389

Last change on this file since 1389 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1IBOUTL ;ALB/AAS - INTEGRATED BILLING OUTPUT UTILITY ROUTINE ; 8-MAR-91
2V ;;2.0;INTEGRATED BILLING;**93**;21-MAR-94
3 ;
4DATE ;
5 ; -get beginning and ending dates
6 ; -output in ibbdt - beginning date
7 ; ibedt - ending date
8 ;
9BDT ; -get beginning date
10 S (IBBDT,IBEDT)=""
11 S %DT="AEX",%DT("A")="Start with DATE: " D ^%DT K %DT G DATEQ:Y<0 S IBBDT=Y
12 ;
13EDT ; -get ending date
14 S %DT="EX" R !,"Go to DATE: ",X:DTIME S:X=" " X=IBBDT G DATEQ:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
15 ;
16DATEQ K %DT
17 Q
18 ;
19PAUSE Q:$E(IOST,1,2)'["C-"
20 F IBJ=$Y:1:(IOSL-4) W !
21 S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
22 Q
23 ;
24DAT1(X,Y) ; Convert FM date to displayable (mm/dd/yy) format.
25 ; -- optional output of time, if $g(y)
26 N DATE,T
27 S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
28 I $G(Y) S T="."_$E($P(X,".",2)_"000000",1,7) I T>0 S DATE=DATE_" "_$S($E(T,2,3)>12:$E(T,2,3)-12,$E(T,2,3)="00":"00",1:+$E(T,2,3))_":"_$E(T,4,5)_$S($E(T,2,5)>1200:" pm",1:" am")
29 Q DATE
30 ;
31DAT2(Y) ; Convert FM date to displayable (mmm dd yyyy) format
32 N %
33 Q:'$D(Y) "" D D^DIQ
34 Q Y
35 ;
36DAT3(X) ;Convert FM date to displayable (mm/dd/yyyy) format.
37 N DATE,YR
38 I $G(X) S YR=($E(X,1,3)+1700)
39 I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$G(YR),1:"")
40 Q $G(DATE)
41 ;
42ACTNM(X) ; -input pointer to action type file (350.1)
43 ; output printable name of action type
44 S Y=$P($G(^IBE(350.1,+X,0)),"^",9) ;new action type
45 Q $S($P($G(^IBE(350.1,+Y,0)),"^",8)]"":$P(^(0),"^",8),$P($G(^IBE(350.1,+X,0)),"^",8)]"":$P(^(0),"^",8),1:$P($G(^IBE(350.1,+X,0)),"^"))
46 ;
47STOP(JOBDESC) ; Has a tasked job been requested to stop by the user?
48 ; Input: JOBDESC -- Description of job to be printed
49 ; Output: 0 -- Job has not been stopped
50 ; 1 -- Job has been stopped
51 ;
52 ; If the job HAS been requested to stop, the Taskman flag ZTSTOP is
53 ; set to 1. The check 'I $G(ZTSTOP)' can also be used in application
54 ; code after calling this function, in the event that the function
55 ; call is deeply nested.
56 ;
57 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 W !!?5,"'"_$S($D(JOBDESC):JOBDESC,1:"Unknown Task")_"' stopped at user's request..."
58 Q $G(ZTSTOP)
59FY(DATE) ;Return FY for date, DT is default
60 NEW FY
61 S:$G(DATE)'?7N.E DATE=DT
62 S FY=$E(DATE,2,3) S:$E(DATE,4,5)>9 FY=FY+1 S:FY=100 FY="00"
63 S:$L(FY)<2 FY="0"_FY
64 Q FY
Note: See TracBrowser for help on using the repository browser.