LRDCOM ; IHS/DIR/FJE - REPORT OF DELETED OR EDITED COMMENTS 2/19/91 10:32 ;
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
BEGIN D:'$D(LRPARAM) ^LRPARAM K DIC S (LRSDFN,LRPAGE,LREND,LRZIP)=0 D ASK
END ;K %,%DT,%H,AGE,DFN,DIC,DOB,I,LRACC,LRDCOM,LRDFN,LRDPF,LRDTIME,LRDUSNM,LRDUZ,LREDT,LREND,LRIDT,LRIDT0,LRIEDT,LRISDT,LRNOW,LRPAGE,LRSDFN,LRSDT,LRTIME,LRUSI,LRUSNM,LRWRD,LRZIP,PNM,SEX,SSN,X,Y
K %,%DT,%H,AGE,DFN,DIC,DOB,I,LRACC,LRDCOM,LRDFN,LRDPF,LRDTIME,LRDUSNM,LRDUZ,LREDT,LREND,LRIDT,LRIDT0,LRIEDT,LRISDT,LRNOW,LRPAGE,LRSDFN,LRSDT,LRTIME,LRUSI,LRUSNM,LRWRD,LRZIP,PNM,SEX,SSN,HRCN,X,Y ;IHS/ANMC/CLS 11/1/95
Q
ASK W !! F I=0:0 W "Audit report of deletions/edited comments for a single patient" S %=1 D YN^DICN Q:% W !,"Enter 'Y'es or 'N'o"
Q:%=-1
I %=1 D ^LRDPA Q:LRDFN=-1 S LRSDFN=LRDFN D ^LRWU3 Q:LREND D DCOM Q
D ^LRWU3 I 'LREND D DCOM
Q
DCOM S ZTRTN="DQ^LRDCOM" D IO^LRWU
Q
DQ S:$D(ZTQUEUED) ZTREQ="@" U IO S X="N",%DT="T" D ^%DT,DD^LRX S LRNOW=Y D HDR
;I LRSDFN S LRDFN=LRSDFN D DATE Q:LRZIP S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,?5,"No deleted/edited comments for ",PNM," ",SSN,! Q
I LRSDFN S LRDFN=LRSDFN D DATE Q:LRZIP S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,?5,"No deleted/edited comments for ",PNM," ",HRCN,! Q ;IHS/ANMC/CLS 11/1/95
S LRDFN=0 F I=0:0 S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D DATE Q:LREND
W:'LRZIP !,?24,"No deleted/edited comments",!
Q
DATE S LRIEDT=9999999-LREDT,LRISDT=9999999-LRSDT,LRIDT=LRISDT F I=0:0 S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LRIEDT) I $D(^(LRIDT,1,"AC")) S LRZIP=1 D SETUP Q:LREND
Q
SETUP S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRIDT0=^LR(LRDFN,"CH",LRIDT,0),LRACC=$P(LRIDT0,U,6),Y=$P(LRIDT0,U) D DD^LRX S LRTIME=Y D PT^LRX
I $Y>(IOSL-7) D:$E(IOST,1,2)="C-" WAIT Q:LREND D HDR
;W !,LRACC,?15,PNM," ",SSN,!,?15,"Collected: ",LRTIME
W !,LRACC,?15,PNM," ",HRCN,!,?15,"Collected: ",LRTIME ;IHS/ANMC/CLS 11/1/95
S LRDUZ=0 F I=0:0 S LRDUZ=$O(^LR(LRDFN,"CH",LRIDT,1,"AC",LRDUZ)) Q:LRDUZ<1 S %H=0 F I=0:0 S %H=$O(^LR(LRDFN,"CH",LRIDT,1,"AC",LRDUZ,%H)) Q:%H<1 S LRDCOM=^(%H) D TIME S Y=% D DD^LRX S LRDTIME=Y,X=LRDUZ D DUZ^LRX S LRDUSNM=LRUSNM D DELCOM
Q
DELCOM S Y=$P(LRDCOM,U) D DD^LRX S X=$P(LRDCOM,U,2) D DUZ^LRX W !?15,"Verified: ",Y," by ",LRUSNM,!?15,"Comment deleted/edited: ",LRDTIME," by ",LRDUSNM,!,?5,$P(LRDCOM,U,3),!
Q
WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="^" LREND=1
Q
HDR W @IOF,!,?24,"DELETED/EDITED COMMENTS",?65,LRNOW,! S Y=LREDT D DD^LRX W ?24,"from ",$S(Y="00/00/00":"LAST",1:Y) S Y=LRSDT\1,LRPAGE=LRPAGE+1 D DD^LRX W " to ",Y,?65,"page ",LRPAGE,!
Q
TIME S %=%H>21608+%H-.1,%Y=%\365.25+141,%=%#365.25\1
S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
S X=%Y_"00"+%M_"00"+%D K %M,%D,%Y
S %=$P(%H,",",2),%=%#3600\60/100+(%\3600)/100,%=X_%
Q
LRDCOM ; IHS/DIR/FJE - REPORT OF DELETED OR EDITED COMMENTS 2/19/91 10:32 ;
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
BEGIN IF '$DATA(LRPARAM)
DO ^LRPARAM
KILL DIC
SET (LRSDFN,LRPAGE,LREND,LRZIP)=0
DO ASK
END ;K %,%DT,%H,AGE,DFN,DIC,DOB,I,LRACC,LRDCOM,LRDFN,LRDPF,LRDTIME,LRDUSNM,LRDUZ,LREDT,LREND,LRIDT,LRIDT0,LRIEDT,LRISDT,LRNOW,LRPAGE,LRSDFN,LRSDT,LRTIME,LRUSI,LRUSNM,LRWRD,LRZIP,PNM,SEX,SSN,X,Y
+1 ;IHS/ANMC/CLS 11/1/95
KILL %,%DT,%H,AGE,DFN,DIC,DOB,I,LRACC,LRDCOM,LRDFN,LRDPF,LRDTIME,LRDUSNM,LRDUZ,LREDT,LREND,LRIDT,LRIDT0,LRIEDT,LRISDT,LRNOW,LRPAGE,LRSDFN,LRSDT,LRTIME,LRUSI,LRUSNM,LRWRD,LRZIP,PNM,SEX,SSN,HRCN,X,Y
+2 QUIT
ASK WRITE !!
FOR I=0:0
WRITE "Audit report of deletions/edited comments for a single patient"
SET %=1
DO YN^DICN
IF %
QUIT
WRITE !,"Enter 'Y'es or 'N'o"
+1 IF %=-1
QUIT
+2 IF %=1
DO ^LRDPA
IF LRDFN=-1
QUIT
SET LRSDFN=LRDFN
DO ^LRWU3
IF LREND
QUIT
DO DCOM
QUIT
+3 DO ^LRWU3
IF 'LREND
DO DCOM
+4 QUIT
DCOM SET ZTRTN="DQ^LRDCOM"
DO IO^LRWU
+1 QUIT
DQ IF $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
SET X="N"
SET %DT="T"
DO ^%DT
DO DD^LRX
SET LRNOW=Y
DO HDR
+1 ;I LRSDFN S LRDFN=LRSDFN D DATE Q:LRZIP S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,?5,"No deleted/edited comments for ",PNM," ",SSN,! Q
+2 ;IHS/ANMC/CLS 11/1/95
IF LRSDFN
SET LRDFN=LRSDFN
DO DATE
IF LRZIP
QUIT
SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
WRITE !,?5,"No deleted/edited comments for ",PNM," ",HRCN,!
QUIT
+3 SET LRDFN=0
FOR I=0:0
SET LRDFN=$ORDER(^LR(LRDFN))
IF LRDFN<1
QUIT
DO DATE
IF LREND
QUIT
+4 IF 'LRZIP
WRITE !,?24,"No deleted/edited comments",!
+5 QUIT
DATE SET LRIEDT=9999999-LREDT
SET LRISDT=9999999-LRSDT
SET LRIDT=LRISDT
FOR I=0:0
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
IF LRIDT<1!(LRIDT>LRIEDT)
QUIT
IF $DATA(^(LRIDT,1,"AC"))
SET LRZIP=1
DO SETUP
IF LREND
QUIT
+1 QUIT
SETUP SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
SET LRIDT0=^LR(LRDFN,"CH",LRIDT,0)
SET LRACC=$PIECE(LRIDT0,U,6)
SET Y=$PIECE(LRIDT0,U)
DO DD^LRX
SET LRTIME=Y
DO PT^LRX
+1 IF $Y>(IOSL-7)
IF $EXTRACT(IOST,1,2)="C-"
DO WAIT
IF LREND
QUIT
DO HDR
+2 ;W !,LRACC,?15,PNM," ",SSN,!,?15,"Collected: ",LRTIME
+3 ;IHS/ANMC/CLS 11/1/95
WRITE !,LRACC,?15,PNM," ",HRCN,!,?15,"Collected: ",LRTIME
+4 SET LRDUZ=0
FOR I=0:0
SET LRDUZ=$ORDER(^LR(LRDFN,"CH",LRIDT,1,"AC",LRDUZ))
IF LRDUZ<1
QUIT
SET %H=0
FOR I=0:0
SET %H=$ORDER(^LR(LRDFN,"CH",LRIDT,1,"AC",LRDUZ,%H))
IF %H<1
QUIT
SET LRDCOM=^(%H)
DO TIME
SET Y=%
DO DD^LRX
SET LRDTIME=Y
SET X=LRDUZ
DO DUZ^LRX
SET LRDUSNM=LRUSNM
DO DELCOM
+5 QUIT
DELCOM SET Y=$PIECE(LRDCOM,U)
DO DD^LRX
SET X=$PIECE(LRDCOM,U,2)
DO DUZ^LRX
WRITE !?15,"Verified: ",Y," by ",LRUSNM,!?15,"Comment deleted/edited: ",LRDTIME," by ",LRDUSNM,!,?5,$PIECE(LRDCOM,U,3),!
+1 QUIT
WAIT READ !,"PRESS '^' TO STOP ",X:DTIME
IF X="^"
SET LREND=1
+1 QUIT
HDR WRITE @IOF,!,?24,"DELETED/EDITED COMMENTS",?65,LRNOW,!
SET Y=LREDT
DO DD^LRX
WRITE ?24,"from ",$SELECT(Y="00/00/00":"LAST",1:Y)
SET Y=LRSDT\1
SET LRPAGE=LRPAGE+1
DO DD^LRX
WRITE " to ",Y,?65,"page ",LRPAGE,!
+1 QUIT
TIME SET %=%H>21608+%H-.1
SET %Y=%\365.25+141
SET %=%#365.25\1
+1 SET %D=%+306#(%Y#4=0+365)#153#61#31+1
SET %M=%-%D\29+1
+2 SET X=%Y_"00"+%M_"00"+%D
KILL %M,%D,%Y
+3 SET %=$PIECE(%H,",",2)
SET %=%#3600\60/100+(%\3600)/100
SET %=X_%
+4 QUIT
