source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAUDIT.m@ 949

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1YTAUDIT ;SLC/TGA-AUDIT PSYCH TESTS ; 7/10/89 11:20 ;
2 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
3 ;
4 ; Called from the top by MENU option YSTSTAUD
5 ;
6 W @IOF,?30,"Test/Interview Audit" W !!!
71 ;
8 S %DT="AEQ",%DT("A")="BEGINNING DATE: " D ^%DT G:Y<1 END S YSB=Y
9 S %DT("A")="ENDING DATE: " D ^%DT G:Y<1 END I Y<YSB W " ?",$C(7),!,"Ending date may not be after begining date!" G 1
10 S YSE=Y,YSFLB=YSB-1,%ZIS="Q" D ^%ZIS G:POP END I $D(IO("Q")) S ZTRTN="ENP^YTAUDIT",(ZTSAVE("YSB"),ZTSAVE("YSE"),ZTSAVE("YSFLB"),ZTSAVE("YSFLB"))="",ZTDESC="YS AUDIT RPT" D ^%ZTLOAD G END
11ENP ;
12 U IO S YSLFT=0,P0=$S(IOST?1"P".E:1,1:0),P1=5 D H S P=0 F S P=$O(^YTD(601.2,P)) Q:'P!(YSLFT) S T=0 F S T=$O(^YTD(601.2,P,1,T)) Q:'T!(YSLFT) Q:'$D(^YTT(601,T)) F D=YSFLB:0 S D=$O(^YTD(601.2,P,1,T,1,D)) Q:'D!(D>YSE) D P Q:YSLFT
13 W ! D KILL^%ZTLOAD,^%ZISC G END
14P ;
15 S D(1)=$G(^YTD(601.2,P,1,T,1,D,0)),P(1)=$S($D(^DPT(P,0)):$P(^(0),U),1:P),T(1)=$S($D(^YTT(601,T,0)):$P(^(0),U),1:T),D(3)=$P(D(1),U,3),D(4)=$P(D(1),U,4)
16 S D(3)=$S($D(^VA(200,+D(3),0)):$P(^(0),U),1:D(3)),D(4)=$S($D(^VA(200,+D(4),0)):$P(^(0),U),1:D(4))
17 D:$Y+P1>IOSL CK Q:YSLFT W P(1),?35,T(1),?47,$$FMTE^XLFDT(D,"5ZD"),!?10,D(4),?49,D(3),!! Q
18END ;
19 K %DT,%ZIS,D,I0,IO("Q"),YSLFT,P,P0,P1,T,X,Y,YSB,YSE,YSFLB,ZTSK Q
20H ;
21 W @IOF,"Test Audit for Period ",?22 S Y=YSB D DT W ?34," through ",?42 S Y=YSE D DT W !,"Patient",?35,"Instrument",?47,"Date",!?10,"Initiated by",?49,"Requested by",!! Q
22CK ;
23 D:'P0 WAIT^YSUTL Q:YSLFT D:P0 H Q
24 Q
25DT ;
26 I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
Note: See TracBrowser for help on using the repository browser.