1 | LRDCOM ;SLC/BA - REPORT OF DELETED OR EDITED COMMENTS ;2/19/91 10:32 ;
|
---|
2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
---|
3 | BEGIN D:'$D(LRPARAM) ^LRPARAM K DIC S (LRSDFN,LRPAGE,LREND,LRZIP)=0 D ASK
|
---|
4 | 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
|
---|
5 | Q
|
---|
6 | 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"
|
---|
7 | Q:%=-1
|
---|
8 | I %=1 D ^LRDPA Q:LRDFN=-1 S LRSDFN=LRDFN D ^LRWU3 Q:LREND D DCOM Q
|
---|
9 | D ^LRWU3 I 'LREND D DCOM
|
---|
10 | Q
|
---|
11 | DCOM S ZTRTN="DQ^LRDCOM" D IO^LRWU
|
---|
12 | Q
|
---|
13 | DQ S:$D(ZTQUEUED) ZTREQ="@" U IO S X="N",%DT="T" D ^%DT,DD^LRX S LRNOW=Y D HDR
|
---|
14 | 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
|
---|
15 | S LRDFN=0 F I=0:0 S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D DATE Q:LREND
|
---|
16 | W:'LRZIP !,?24,"No deleted/edited comments",!
|
---|
17 | Q
|
---|
18 | 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
|
---|
19 | Q
|
---|
20 | 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
|
---|
21 | I $Y>(IOSL-7) D:$E(IOST,1,2)="C-" WAIT Q:LREND D HDR
|
---|
22 | W !,LRACC,?15,PNM," ",SSN,!,?15,"Collected: ",LRTIME
|
---|
23 | 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
|
---|
24 | Q
|
---|
25 | 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),!
|
---|
26 | Q
|
---|
27 | WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="^" LREND=1
|
---|
28 | Q
|
---|
29 | 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,!
|
---|
30 | Q
|
---|
31 | TIME S %=%H>21608+%H-.1,%Y=%\365.25+141,%=%#365.25\1
|
---|
32 | S %D=%+306#(%Y#4=0+365)#153#61#31+1,%M=%-%D\29+1
|
---|
33 | S X=%Y_"00"+%M_"00"+%D K %M,%D,%Y
|
---|
34 | S %=$P(%H,",",2),%=%#3600\60/100+(%\3600)/100,%=X_%
|
---|
35 | Q
|
---|