YTAUDIT ;SLC/TGA-AUDIT PSYCH TESTS ; 7/10/89 11:20 ;
;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
;
; Called from the top by MENU option YSTSTAUD
;
W @IOF,?30,"Test/Interview Audit" W !!!
1 ;
S %DT="AEQ",%DT("A")="BEGINNING DATE: " D ^%DT G:Y<1 END S YSB=Y
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
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
ENP ;
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
W ! D KILL^%ZTLOAD,^%ZISC G END
P ;
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)
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))
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
END ;
K %DT,%ZIS,D,I0,IO("Q"),YSLFT,P,P0,P1,T,X,Y,YSB,YSE,YSFLB,ZTSK Q
H ;
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
CK ;
D:'P0 WAIT^YSUTL Q:YSLFT D:P0 H Q
Q
DT ;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAUDIT 1672 printed Apr 09, 2024@21:22:18 Page 2
YTAUDIT ;SLC/TGA-AUDIT PSYCH TESTS ; 7/10/89 11:20 ;
+1 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
+2 ;
+3 ; Called from the top by MENU option YSTSTAUD
+4 ;
+5 WRITE @IOF,?30,"Test/Interview Audit"
WRITE !!!
1 ;
+1 SET %DT="AEQ"
SET %DT("A")="BEGINNING DATE: "
DO ^%DT
if Y<1
GOTO END
SET YSB=Y
+2 SET %DT("A")="ENDING DATE: "
DO ^%DT
if Y<1
GOTO END
IF Y<YSB
WRITE " ?",$CHAR(7),!,"Ending date may not be after begining date!"
GOTO 1
+3 SET YSE=Y
SET YSFLB=YSB-1
SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO END
IF $DATA(IO("Q"))
SET ZTRTN="ENP^YTAUDIT"
SET (ZTSAVE("YSB"),ZTSAVE("YSE"),ZTSAVE("YSFLB"),ZTSAVE("YSFLB"))=""
SET ZTDESC="YS AUDIT RPT"
DO ^%ZTLOAD
GOTO END
ENP ;
+1 USE IO
SET YSLFT=0
SET P0=$SELECT(IOST?1"P".E:1,1:0)
SET P1=5
DO H
SET P=0
FOR
SET P=$ORDER(^YTD(601.2,P))
if 'P!(YSLFT)
QUIT
SET T=0
FOR
SET T=$ORDER(^YTD(601.2,P,1,T))
if 'T!(YSLFT)
QUIT
if '$DATA(^YTT(601,T))
QUIT
FOR D=YSFLB:0
SET D=$ORDER(^YTD(601.2,P,1,T,1,D))
if 'D!(D>YSE)
QUIT
DO P
if YSLFT
QUIT
+2 WRITE !
DO KILL^%ZTLOAD
DO ^%ZISC
GOTO END
P ;
+1 SET D(1)=$GET(^YTD(601.2,P,1,T,1,D,0))
SET P(1)=$SELECT($DATA(^DPT(P,0)):$PIECE(^(0),U),1:P)
SET T(1)=$SELECT($DATA(^YTT(601,T,0)):$PIECE(^(0),U),1:T)
SET D(3)=$PIECE(D(1),U,3)
SET D(4)=$PIECE(D(1),U,4)
+2 SET D(3)=$SELECT($DATA(^VA(200,+D(3),0)):$PIECE(^(0),U),1:D(3))
SET D(4)=$SELECT($DATA(^VA(200,+D(4),0)):$PIECE(^(0),U),1:D(4))
+3 if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE P(1),?35,T(1),?47,$$FMTE^XLFDT(D,"5ZD"),!?10,D(4),?49,D(3),!!
QUIT
END ;
+1 KILL %DT,%ZIS,D,I0,IO("Q"),YSLFT,P,P0,P1,T,X,Y,YSB,YSE,YSFLB,ZTSK
QUIT
H ;
+1 WRITE @IOF,"Test Audit for Period ",?22
SET Y=YSB
DO DT
WRITE ?34," through ",?42
SET Y=YSE
DO DT
WRITE !,"Patient",?35,"Instrument",?47,"Date",!?10,"Initiated by",?49,"Requested by",!!
QUIT
CK ;
+1 if 'P0
DO WAIT^YSUTL
if YSLFT
QUIT
if P0
DO H
QUIT
+2 QUIT
DT ;
+1 IF Y
WRITE $PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "
if Y#100
WRITE $JUSTIFY(Y#100\1,2)_","
WRITE Y\10000+1700
if Y#1
WRITE " "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12)
QUIT
