- 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