Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRDCOM

LRDCOM.m

Go to the documentation of this file.
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