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

LRMLREI.m

Go to the documentation of this file.
  1. LRMLREI ;BPFO/DTG - EDITED ITEMS REPORT PGM FOR NTRT PROCESS ;02/10/2016
  1. ;;5.2;LAB SERVICE;**468**;FEB 10 2016;Build 64
  1. ;
  1. EN ;entry point
  1. N DA,DIE,DR,A,LD,LT,B,PS,PDT,LDT,DIDEL,LRSITE,LRFDAT,LRTDAT,LRFD,LRDTA,C,D,E,K,PAGE,LRTST
  1. N LRTSTN,LRTE,X,FO,FN,CRT,LR1,PGHD,QUIT,LRDT,ULINE,XDD,Y,LRROOT,LRROOTA,POP
  1. N DIROUT,DTOUT,FF,HD,I
  1. S U="^" I $G(DT)="" S DT=$$DT^XLFDT
  1. S B=$$SITE^VASITE,B=$P(B,U,1) I 'B D I B="" S LRSITE="Not specified" G ST ; not set up
  1. . S B=$$GET1^DIQ(8989.3,"1,",217,"I")
  1. S PS=$O(^LAB(66.4,"B",B,0)) I PS="" S LRSITE="Not specified" G ST ; 66.4 not set up
  1. S A=$$GET1^DIQ(66.4,PS_",",.01,"I"),LRSITE=$$KSP^XUPARAM("WHERE")
  1. I LRSITE="" S LRSITE="Not specified"
  1. ST ;
  1. K EDPRT,ULINE S XDD=^DD("DD"),$P(ULINE,"_",79)="_" K AUTO
  1. D HOME^%ZIS S FF=IOF,HD="Lab NTRT File 60 Audited items Report" W @IOF,!?(IOM-$L(HD)\2),HD,!!!
  1. S Y=DT X XDD S LRDT(0)=Y,PGHD="Lab NTRT File 60 Audited items Report"
  1. S LRFD=$$NOW^XLFDT
  1. ;
  1. S DIR(0)="D^3160101:"_LRFD_":EX",DIR("A")="Enter From Date" D ^DIR K DIR
  1. I $D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) W !,*7,"Starting Date Not Selected" G DONE
  1. S LRFDAT=Y\1
  1. S DIR(0)="D^"_LRFDAT_":"_LRFD_":EX",DIR("A")="Enter To Date" D ^DIR K DIR
  1. I $D(DUOUT)!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) W !,*7,"Ending Date Not Selected" G DONE
  1. S LRTDAT=Y
  1. ;
  1. DEVICE S %ZIS="Q",%ZIS("A")="Output device: " D ^%ZIS
  1. I POP D HOME^ZIS W !,*7,"No Device Selected" G DONE
  1. I $D(IO("Q"))!(IOT="HFS") N ZTDTH,ZTRTN,ZTIO,ZTDESC,ZTIO,ZTSAVE S ZTDTH=$$NOW^XLFDT,ZTRTN="BK^LRMLREI",ZTIO=ION,ZTDESC="Lab NTRT Audit Items Report" D D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! G DO
  1. . F I="D*","XDD","ULINE","HD","FF","PGHD","LRSITE","LRFDAT","LRTDAT","LRFD" S ZTSAVE(I)=""
  1. G PRT
  1. ;
  1. ;
  1. DO K ZTSK,ZTDTH,ZTRTN,ZTIO,ZTDESC,ZTIO,ZTSAVE
  1. G DONE
  1. ;
  1. DONE ; exit
  1. K DA,DIE,DR,A,LD,LT,B,PS,PDT,LDT,DIDEL,LRSITE,LRFDAT,LRTDAT,LRFD,LRDTA,C,D,E,K,PAGE,LRTST
  1. K LRTSTN,LRTE,X,FO,FN,CRT,LR1,PGHD,QUIT,LRDT,ULINE,XDD,Y,LRROOT,LRROOTA,POP
  1. K DIROUT,DTOUT,FF,HD,I
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. LRS(A) ; get edit type/field
  1. N LRSTRING
  1. I A="" Q ""
  1. S LRSTRING=$S(A="M":"MLTF VUID",A="C":"CREATION DATE",A="T":"TST INACT DT",A="R":"SPEC INACT DT",A="E":"NTRT EXPT FLG",A="Y":"TEST TYPE",A="S":"SPEC CREATE DT",1:"")
  1. Q LRSTRING
  1. ;
  1. BK ;entry if queued
  1. PRT ; print report
  1. S (QUIT,PAGE)=0,CRT=$S($E(IOST,1,2)="C-":1,1:0),LRTSTN=""
  1. I CRT,PAGE=0 W @IOF
  1. S PAGE=PAGE+1 D HEADER
  1. S LRROOT="^LAB(60,""B"")",LRROOTA="^LAB(60,""B"""
  1. ;S LRTST=0
  1. PL ;S LRTST=$O(^LAB(60,LRTST)) I 'LRTST G PDONE
  1. ; Step down the B X-ref - exclude synomyms
  1. S LRROOT=$Q(@LRROOT) I $E(LRROOT,1,$L(LRROOTA))'=LRROOTA G PDONE
  1. I $G(@LRROOT)=1 G PL
  1. I $G(@LRROOT) G PL
  1. S LRTST=$QS(LRROOT,4)
  1. ;
  1. S LRTSTN=$$GET1^DIQ(60,LRTST_",",.01,"I"),LRTSTN=$E(LRTSTN,1,40)
  1. S LRTE=0,LR1=0
  1. PLE S LRTE=$O(^LAB(60,LRTST,15,LRTE)) I 'LRTE G PL
  1. S B=+LRTE_","_(+LRTST)
  1. K LRDTA,C,LRER D GETS^DIQ(60.28,B,"**","IE","C","LRER")
  1. I $G(LRER("DIERR"))'="" G PLE
  1. M LRDTA=C("60.28",B_",") K C
  1. ; edit date
  1. S C=$G(LRDTA(.01,"I")) I C="" G PLE
  1. S D=C\1 I D<LRFDAT G PLE
  1. I D>LRTDAT G PLE
  1. S C=$$FMTE^XLFDT(C,"7M")
  1. I LR1=0 W !,"TEST: ",LRTSTN
  1. S LR1=1
  1. ; specimen name if one
  1. S D=$G(LRDTA(.06,"I")) I D'="" S X=$$GET1^DIQ(60.01,D_","_LRTST,.01,"E"),X=$E(X,1,30) W !,?10,"Specimen: ",X
  1. ; edit field
  1. S K=$G(LRDTA(.03,"I")) I K'="" S B=$$LRS(K)
  1. ; user who did transaction
  1. S E=$G(LRDTA(.02,"E")) I E'="" S E=$E(E,1,14)
  1. ; test type
  1. S FO=$G(LRDTA(.04,"I")) I FO'="" D ;<
  1. . I K="M" S FO=$$GET1^DIQ(66.3,FO_",",.01),FO=$E(FO,1,15) Q
  1. . I K="C"!(K="T")!(K="R")!(K="S") S FO=FO\1 S:FO<2 FO="" I FO>1 S FO=$$FMTE^XLFDT(FO,9)
  1. S FN=$G(LRDTA(.05,"I")) I FN'="" D ;<
  1. . I K="M" S FN=$$GET1^DIQ(66.3,FN_",",.01),FN=$E(FN,1,15) Q
  1. . I K="C"!(K="T")!(K="R")!(K="S") S FN=FN\1 S:FN<2 FN="" I FN>1 S FN=$$FMTE^XLFDT(FN,9)
  1. W !,?1,C,?18,B,?32,E,?48,FO,?65,FN
  1. ;
  1. I CRT,($Y>(IOSL-4)) D I QUIT G PDONE
  1. .D PAUSE
  1. .Q:QUIT
  1. .W @IOF
  1. .D HEADER
  1. E I ('CRT),($Y>(IOSL-2)) D
  1. .W @IOF
  1. .D HEADER
  1. ;
  1. G PLE
  1. ;
  1. PDONE ; print done
  1. W !!,?29,$S(QUIT'=1:"--- Report Finished ---",1:"--- Report Aborted ---") G DONE
  1. ;
  1. Q:QUIT
  1. N LINE
  1. I $Y>1 W @IOF
  1. W !,?22,HD
  1. W ?70,"Page ",PAGE,!,?27,"Date Printed: "_$$FMTE^XLFDT(DT),!
  1. S PAGE=PAGE+1
  1. ;
  1. W !,?1,"Date",?18,"Edit Field",?32,"User",?48,"Old Value",?65,"New Value"
  1. W !,ULINE
  1. I PAGE>2 W !,"TEST: ",LRTSTN
  1. Q
  1. ;
  1. PAUSE N DIR,DIRUT,X,Y
  1. F Q:$Y>(IOSL-3) W !
  1. S DIR(0)="E" D ^DIR
  1. I ('(+Y))!$D(DIRUT) S QUIT=1
  1. Q