source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRDCOM.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1LRDCOM ;SLC/BA - REPORT OF DELETED OR EDITED COMMENTS ;2/19/91 10:32 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3BEGIN D:'$D(LRPARAM) ^LRPARAM K DIC S (LRSDFN,LRPAGE,LREND,LRZIP)=0 D ASK
4END 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
6ASK 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
11DCOM S ZTRTN="DQ^LRDCOM" D IO^LRWU
12 Q
13DQ 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
18DATE 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
20SETUP 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
25DELCOM 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
27WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="^" LREND=1
28 Q
29HDR 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
31TIME 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
Note: See TracBrowser for help on using the repository browser.