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

LRJSAU60.m

Go to the documentation of this file.
  1. LRJSAU60 ;ALB/PO/DK/TMK Lab File 60 Audit Manager ;08/16/2010 15:54:29
  1. ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1. ;
  1. ;Reference to direct lookup via fileman to DD global supported by ICR #4281
  1. ;Reference to direct lookup of subfile name in DD global supported by ICR #4768
  1. ;Reference to sort and print templates in file 1.1 (AUDIT) supported by ICR #4806
  1. ;
  1. AUDSET ; -- enable audit fields for file 60
  1. ; Called from:
  1. ; LRJ SYS SET AUDITED FLAG FOR FIELDS protocol
  1. ;
  1. N LRI,LRAFLDS,FILENUM,FIELDNUM,FIELDNAM,XINDEX,XISAUD,XAUDSET,Q
  1. N DIR,DIC,DIK,DA,DUOUT,DTOUT,DIROUT,X,Y
  1. D FULL^VALM1
  1. I '$D(^TMP($J,"LRAUDREQ")) D
  1. .F LRI=1:1 S LRALINE=$P($TEXT(AFLDS+LRI^LRJSAU),";;",2) Q:LRALINE="$$END$$" D
  1. ..I +LRALINE'=60 Q
  1. ..S LRSUBFLD=$P($P(LRALINE,"^"),";",2)
  1. ..F Q=1:1:$L($P(LRALINE,"^",2),";") D
  1. ...I 'LRSUBFLD S ^TMP($J,"LRAUDREQ","60,"_$P($P(LRALINE,"^",2),";",Q))=1 Q
  1. ...S ^TMP($J,"LRAUDREQ","60,"_LRSUBFLD_","_$P($P(LRALINE,"^",2),";",Q))=1
  1. S FIELDNUM="",DIC="^DD(60," ;ICR 4281
  1. S DIC(0)="AEQZ",DIC("A")="Field: "
  1. F D ^DIC D Q:Y'=""
  1. .I Y>0,$G(^TMP($J,"LRAUDREQ","60,"_+Y)) D
  1. ..W !,"'SF' cannot be used to turn auditing off for any required audit field."
  1. ..S Y=""
  1. .I Y>0 S FIELDNUM=$P(Y,"^"),FIELDNAM=$P(Y,"^",2)
  1. Q:FIELDNUM=""
  1. ;check if field is multiple
  1. S FILENUM=+$$GFLDSB(60,FIELDNUM),FILENUM=$S(FILENUM>0:FILENUM,1:60)
  1. I FILENUM'=60 D
  1. . S DIC="^DD("_FILENUM_"," ; ICR 4281
  1. . S DIC(0)="AEQMZ",DIC("A")="Sub-File "_FIELDNAM_" Field: "
  1. . F D ^DIC D Q:Y'=""
  1. .. I Y>0,$G(^TMP($J,"LRAUDREQ","60,"_FIELDNUM_","_+Y)) D
  1. ... W !,"'SF' cannot be used to turn auditing off for any required audit field."
  1. ... S Y=""
  1. .S FIELDNUM=$S(Y>0:$P(Y,"^"),1:"")
  1. Q:FIELDNUM=""
  1. S XISAUD=$$ISAUDON(FILENUM,FIELDNUM)
  1. W !," File "_FILENUM_" - Field "_FIELDNUM_" is "_$S(XISAUD:"already ",1:"not currently ")_"audited."
  1. N DIR
  1. S DIR(0)="Y"
  1. S DIR("A")="Do you wish to turn auditing "_$S(XISAUD:"OFF ",1:"ON ")_"for this field?"
  1. S DIR("B")="No"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1. S XAUDSET=+Y
  1. N DIR
  1. I 'XAUDSET D Q
  1. .W !!," NO ACTION TAKEN"
  1. .D PAUSE^VALM1
  1. .D REFRESH^LRJSAU
  1. ;if not audited, turn auditing on
  1. I 'XISAUD D Q
  1. .S XINDEX=$O(^LABAUD(64.9178,"B",60,""))
  1. .S XSUB=$S(FILENUM=60:FIELDNUM,1:FILENUM_","_FIELDNUM)
  1. .S DIC(0)="L",DA(1)=XINDEX,DLAYGO=64.9178
  1. .S DIC="^LABAUD(64.9178,"_XINDEX_",1,",X=XSUB
  1. .D FILE^DICN K DLAYGO
  1. .D TURNON^DIAUTL(FILENUM,FIELDNUM)
  1. .W !!," CHANGE MADE: File "_FILENUM_" - Field "_FIELDNUM_" is now audited"
  1. .D PAUSE^VALM1
  1. .D REFRESH^LRJSAU
  1. ;if audited, turn auditing off
  1. I XISAUD D
  1. .S XINDEX=$O(^LABAUD(64.9178,"B",60,""))
  1. .S XSUB=$S(FILENUM=60:FIELDNUM,1:FILENUM_","_FIELDNUM)
  1. .I $D(^LABAUD(64.9178,XINDEX,1,"B",XSUB)) D
  1. .. S DA(1)=XINDEX
  1. .. S DA=$O(^LABAUD(64.9178,XINDEX,1,"B",XSUB,""))
  1. .. S DIK="^LABAUD(64.9178,"_XINDEX_",1,"
  1. .. D ^DIK
  1. .D TURNON^DIAUTL(FILENUM,FIELDNUM,"n")
  1. .W !!," CHANGE MADE: File "_FILENUM_" - Field "_FIELDNUM_" is now NOT audited"
  1. .D PAUSE^VALM1
  1. .D REFRESH^LRJSAU
  1. Q
  1. ;
  1. AUDLIST ; -- list file 60 audited fields
  1. ; Called from:
  1. ; LRJ SYS LIST AUDITED FIELDS protocol
  1. ;
  1. N X
  1. D FULL^VALM1
  1. S VALMCNT=0
  1. D KILL^LRJSAU
  1. D KILL^VALM10()
  1. S X=$$AUDCHK(1)
  1. Q
  1. ;
  1. AUDISP ; -- Display file 60 changes
  1. ; Called from:
  1. ; LRJ SYS DISPLAY FILE 60 CHANGES protocol
  1. ;
  1. ; VALMCNT - [global/Input/Output] last entry in List Manager
  1. ; VALMAR - [global/Output] reference to List Manager buffer
  1. ; like "^TMP("LRJ SYS ORDERS MANAGER",$JOB)"
  1. ;
  1. ;TSKCALL set if called from TaskMan
  1. N FR,TO,FLDS,DIC,IOP,LRD0,LRD00,X,LRDATA,XSUB,XENT,XSTR,XLRIEN,XLRIEN1,XD1,XSQ,XD2,XSP,XLOINC
  1. N LRDT,LRDONE,LRFAC,LRFLDNM,LRGBL,LRIEN,LRNEW,LRARRY,LROLD,LROUT,LRSET,LRUSER,SPACE,LRDEV,XNEW,BY
  1. I '$G(TSKCALL) N LRTODT,LRFRDT,LRTO,LRFROM D FULL^VALM1
  1. S VALMCNT=0,XSUB=" "
  1. D KILL^LRJSAU
  1. I '$G(TSKCALL) D KILL^VALM10()
  1. S SPACE=$J("",47)
  1. S LROUT=0
  1. ; set up parameters to run the print template to a null device and store the results in LRDATA array
  1. ; in case there is no null defined, print template with IOP of ";;99999" still will store the results in LRDATA
  1. ;
  1. ;kill to variable DIA needed because otherwise carryover
  1. ;occurs if user invokes various audits in same session - [krused]
  1. K DIA
  1. S DIC="^DIA(60," ;ICR #4806
  1. S BY="[LRJ SYS DISPLAY FILE 60 CHANGE]"
  1. S FLDS="[LRJ SYS DISPLAY FILE 60 CHANGE]"
  1. ;
  1. F LRDEV="NULL DEVICE","NULL" S IOP=$$GIOP(LRDEV) QUIT:IOP'=""
  1. I IOP="" S IOP=";;99999" ; if no IOP then set the number of lines per page to maximum
  1. ;
  1. I '$G(TSKCALL) D FILENUM(.LROUT) Q:LROUT
  1. I '$G(TSKCALL) I $G(LRFRDT)=""!($G(LRTODT)="") G AUDISP
  1. I '$G(TSKCALL) I LRFRDT<0!(LRTODT<0) G AUDISP
  1. I $G(TSKCALL) S LRFRDT=LRFROM,LRTODT=LRTO
  1. ; wait message in case many audits to search through
  1. I '$G(TSKCALL) D WAIT^DICD
  1. K ^TMP("LRDATA",$J)
  1. S FR=LRFRDT,TO=LRTODT
  1. D EN1^DIP
  1. ;
  1. ; put the results from ^TMP("LRDATA",$J... into List Manager
  1. S ^TMP("LRJ SYS F60 AUD MANAGER",$J,1)=LRFRDT_"^"_LRTODT
  1. I '$G(TSKCALL) D
  1. .S X="File 60 Audit - From "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT)
  1. .D ADD^LRJSAU(.VALMCNT,X)
  1. S LRD0=0
  1. F S LRD0=$O(^TMP("LRDATA",$J,LRD0)) Q:'LRD0 D
  1. .; sort by new entry added ... all changes made within 2 hours are 'NEW', not 'MODIFIED'
  1. .K LRARRY
  1. .S LRIEN=+$G(^TMP("LRDATA",$J,LRD0,"LRIEN"))
  1. .S LRNEW=+$O(^TMP("LRDATA",$J,"NEW",LRIEN,0))
  1. .I LRNEW,'$D(^TMP("LRDATA",$J,"NEW",LRIEN,LRD0)) S LRNEW=0 ; new entry changed outside 2 hr window
  1. .I LRNEW Q:'$G(^TMP("LRDATA",$J,"NEW",LRIEN,LRD0)) ; change to new entry made inside 2 hr window
  1. .S LRDT=$G(^TMP("LRDATA",$J,LRD0,"LRDT"))
  1. .I LRNEW D ; flag all changed records associated with 'NEW' file 60 entry
  1. .. N Z
  1. .. S Z=0 F S Z=$O(^TMP("LRDATA",$J,"NEW",LRIEN,Z)) Q:'Z S LRARRY(Z)=1
  1. . I 'LRNEW S LRARRY(LRD0)=""
  1. . ; LRD00 = ien of the audit file
  1. . S LRD00=0
  1. . F S LRD00=$O(LRARRY(LRD00)) Q:'LRD00 D
  1. .. K LRDATA,LRSET M LRDATA=^TMP("LRDATA",$J,LRD00)
  1. .. S LRDT=LRDATA("LRDT")
  1. .. S X=" "_$E($$FMTE^XLFDT(LRDT)_SPACE,1,25)_$E(LRDATA("LRUSER")_SPACE,1,40)_LRDATA("LRIEN")
  1. .. S XSUB=$S(LRARRY(LRD00):"NEW",1:"OLD")
  1. .. S ^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD00,"LRDT")=X
  1. .. S X=$P($G(^LAB(60,+$G(LRDATA("LRIEN")),0)),"^")
  1. .. I X="" S X="NONE (DELETED BEFORE BEING COMPLETELY DEFINED)"
  1. .. S X=" TEST NAME: "_X
  1. .. S LRSET("LRIEN")=X
  1. .. S X=" FIELD NAME: "_LRDATA("LRFLDNM")
  1. .. S LRSET("LRFLDNM")=X
  1. .. S X=" OLD VALUE: "_LRDATA("LROLD")
  1. .. S LRSET("LROLD")=X
  1. .. S X=" NEW VALUE: "_LRDATA("LRNEW")
  1. .. S LRSET("LRNEW")=X
  1. .. M ^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD00)=LRSET
  1. .. ;extract file if user requests
  1. .. S XLRIEN=$P(LRDATA("LRIEN"),","),XLRIEN1=$TR($P(LRDATA("LRIEN"),",",2,999),",","~")
  1. .. S ^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN,LRDATA("LRFNUM")_";"_LRDATA("LRFLDNM")_$S(XLRIEN="":"",1:"-"_XLRIEN1),LRDATA("LRDT"),LRD00)=""
  1. ;create extract file entry
  1. S (XSUB,XLRIEN,XD1)="",LRFAC=$$NAME^XUAF4($$KSP^XUPARAM("INST"))
  1. F S XSUB=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB)) Q:XSUB="" D
  1. .S LRGBL=$NA(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT",XSUB))
  1. .S XSTR="File 60 Audit "_$S(XSUB="NEW":"New_",1:"Modified ")_" Entries - From "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT)
  1. .S @LRGBL@(1)=$TR(XSTR,",","")
  1. .S @LRGBL@(2)="Facility,Test Name,Subscript,IEN~subfile IEN,NLT Code,Place holder,Site/Specimen~LOINC,Synonym(s)"
  1. .S @LRGBL@(2)=@LRGBL@(2)_",Fld #,Fld name,Date/Time of change,Previous value,New value"
  1. .S XSQ=2
  1. .F S XLRIEN=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN)) Q:XLRIEN="" D
  1. ..N LRREC,Z
  1. ..K XLRAR M XLRAR=^LAB(60,XLRIEN)
  1. ..S LRREC=$NA(^TMP("LRJ SYS F60 AUD MANAGER",$J,"EXTRACT_INIT",XSUB,XLRIEN))
  1. ..F S LRREC=$Q(@LRREC) Q:$QS(LRREC,5)'=XLRIEN D
  1. ...S XSQ=XSQ+1,LRD00=$QS(LRREC,8)
  1. ...K LRDATA
  1. ...M LRDATA=^TMP("LRDATA",$J,LRD00)
  1. ...;facility name
  1. ...S XSTR=$TR(LRFAC,","," ")
  1. ...;test name
  1. ...S XLRAR(0)=$TR($G(XLRAR(0)),","," ")
  1. ...I XLRAR(0)="" S XLRAR(0)="NONE (DELETED BEFORE BEING COMPLETELY DEFINED)"
  1. ...S XSTR=XSTR_","_$P($G(XLRAR(0)),"^")
  1. ...;test subscript
  1. ...S XSTR=XSTR_","_$P($G(XLRAR(0)),"^",4)
  1. ...;IEN~subfile iens
  1. ...S Z=$P($QS(LRREC,6),"-",2)
  1. ...S XSTR=XSTR_","_XLRIEN_$S(Z="":"",1:"~"_Z)
  1. ...;NLT code
  1. ...S XD1=$P($G(XLRAR(64)),"^")
  1. ...I XD1]"" S XD1=$P($G(^LAM(XD1,0)),"^",2)_"~"
  1. ...S XSTR=XSTR_","_XD1
  1. ...;Place holder
  1. ...S XSTR=XSTR_",~"
  1. ...;site/specimen(s) which linked to LOINC codes at subscript 95.3
  1. ...S XD1=0,(XD2,XSP,XLOINC)="" F S XD1=$O(XLRAR(1,XD1)) Q:XD1="" Q:XD1'?1N.N D
  1. ....S XSP=$P($G(XLRAR(1,XD1,0)),"^"),XSP=$S(XSP]"":$P($G(^LAB(61,XSP,0)),"^"),1:"")
  1. ....S XLOINC=$G(XLRAR(1,XD1,95.3))
  1. ....I XLOINC]"" S XLOINC=$$GET1^DIQ(60.01,XD1_","_XLRIEN,95.3,,"LRMSG")
  1. ....S XD2=$S(XD2]"":XD2_";",1:"")_XSP_"~"_XLOINC
  1. ...S XSTR=XSTR_","_$TR(XD2,","," ")
  1. ...;synonym(s) -- string together
  1. ...S XD1=0,XD2="" F S XD1=$O(XLRAR(5,XD1)) Q:XD1="" Q:XD1'?1N.N S XD2=$S(XD2]"":XD2_";",1:"")_$P(XLRAR(5,XD1,0),"^")
  1. ...S XSTR=XSTR_","_$TR(XD2,","," ")
  1. ...; field number
  1. ...S:LRDATA("LRFNUM")["," LRDATA("LRFNUM")=""""_LRDATA("LRFNUM")_""""
  1. ...S XSTR=XSTR_","_LRDATA("LRFNUM")
  1. ...; field name
  1. ...S:LRDATA("LRFLDNM")["," LRDATA("LRFLDNM")=""""_LRDATA("LRFLDNM")_""""
  1. ...S XSTR=XSTR_","_LRDATA("LRFLDNM")
  1. ...; date/time changed
  1. ...S XSTR=XSTR_","_LRDATA("LRDT")
  1. ...; old value
  1. ...S:LRDATA("LROLD")["," LRDATA("LROLD")=""""_LRDATA("LROLD")_""""
  1. ...S XSTR=XSTR_","_LRDATA("LROLD")
  1. ...; new value
  1. ...S:LRDATA("LRNEW")["," LRDATA("LRNEW")=""""_LRDATA("LRNEW")_""""
  1. ...S XSTR=XSTR_","_LRDATA("LRNEW")
  1. ...S @LRGBL@(XSQ)=XSTR
  1. .Q:$G(TSKCALL)
  1. .S VALMHDR(1)=$J("",21)_"Laboratory Test File (#60) Changes"
  1. .S VALMHDR(2)=$J("",9)_"Date Range: "_$$FMTE^XLFDT(LRFRDT)_" to "_$$FMTE^XLFDT(LRTODT)
  1. .D CHGCAP^VALM("HEADER","DT RECORDED"_$J("",14)_"USER"_$J("",36)_"IEN(s) ")
  1. I '$G(TSKCALL) F XSUB="NEW","OLD" D
  1. .I '$D(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB)) D Q
  1. ..D ADD^LRJSAU(.VALMCNT,"")
  1. ..S X="No "_$S(XSUB="NEW":"New",1:"Modified")_" Entries"
  1. ..D ADD^LRJSAU(.VALMCNT,X)
  1. ..D ADD^LRJSAU(.VALMCNT,"")
  1. .D ADD^LRJSAU(.VALMCNT,"")
  1. .S X=$S(XSUB="NEW":"New",1:"Modified")_" Entries"
  1. .D ADD^LRJSAU(.VALMCNT,X)
  1. .D ADD^LRJSAU(.VALMCNT,"")
  1. .S (LRD0,XENT)=""
  1. .F S LRD0=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0)) Q:LRD0="" D
  1. ..F S XENT=$O(^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0,XENT)) Q:XENT="" D
  1. ...S X=^TMP("LRJ SYS F60 AUD MANAGER",$J,XSUB,LRD0,XENT)
  1. ...D ADD^LRJSAU(.VALMCNT,X)
  1. Q
  1. ;
  1. AUDCHK(DISPLAY) ; -- check files/fields to see if they are audited for file 60
  1. ;
  1. ; DISPLAY - [Input/Optional]
  1. ; - if 0 or does not exist, return 1 if all fields in the list are audited, 0 otherwise
  1. ; if 1 or -1 populate the VALMCNT array too as described below.
  1. ; - if 1 populate VALMCNT for all the fields in the list and change the VALM header
  1. ; - if -1 populate VALMCNT for all the fields that their audit field is turned off, but do not change the VALM header
  1. ;
  1. ; VALMCNT - [global/Input/Output] last entry in List Manager
  1. ; VALMAR - [global/Output] reference to List Manager list of fields that their audit is on or off,
  1. ; like "^TMP("LRJ SYS ORDERS MANAGER",$JOB)"
  1. ;
  1. ; Returns 1 if all audited fields are on, otherwise 0.
  1. ;
  1. N LRI,LRJ,LRALINE,LRAFLDS,LRSUBFLD,LRAUDIT,X,FLDAUDIT,SPACE,HDRDISP,FLDTITL,XAUD,XFILENUM,XNEW
  1. S SPACE=$J("",47)
  1. S DISPLAY=+$G(DISPLAY),XNEW=0
  1. S HDRDISP=0 ; intialize as header not displayed
  1. S LRAUDIT=1 ; assume audit is ON for all fields
  1. F LRI=1:1 S LRALINE=$P($TEXT(AFLDS+LRI^LRJSAU),";;",2) Q:LRALINE="$$END$$" D
  1. .I +LRALINE'=60 Q
  1. .S LRSUBFLD=$P($P(LRALINE,"^"),";",2)
  1. .F LRJ=1:1 S LRAFLDS=$P($P(LRALINE,"^",2),";",LRJ) Q:LRAFLDS="" D
  1. .. D AUDCHK2(+LRALINE,LRSUBFLD,LRAFLDS)
  1. N MONLIST S FILENUM=60 D GMONLIST(FILENUM,.MONLIST)
  1. S XFILENUM="",XNEW=1
  1. F S XFILENUM=$O(MONLIST(XFILENUM)) Q:XFILENUM="" D
  1. .S LRALINE=MONLIST(XFILENUM)
  1. .F LRJ=1:1 S LRAFLDS=$P(LRALINE,";",LRJ) Q:LRAFLDS="" D
  1. .. I XFILENUM=FILENUM,LRJ=1 Q
  1. .. D AUDCHK2(XFILENUM,"",LRAFLDS)
  1. Q LRAUDIT
  1. ;
  1. AUDCHK2(XFILENUM,XFLDSUB,LRAFLDS) ;
  1. ; XFILENUM (input) - file or subfile # if known
  1. ; XFLDSUB (input/opt) - If a subfield and subfile not in XFILENUM, this is the field # for the subfile
  1. N X
  1. S FLDAUDIT=1 ; assume audit is ON for ONLY this field.
  1. I XFLDSUB D ; If present, field is within a subfile XFLDSUB of XFILENUM
  1. .N OUT
  1. .S OUT=+$$GFLDSB(XFILENUM,XFLDSUB)
  1. .I OUT S XFILENUM=OUT
  1. I '$$ISAUDON(XFILENUM,LRAFLDS) S LRAUDIT=0,FLDAUDIT=0
  1. I (DISPLAY=1)!((DISPLAY=-1)&(FLDAUDIT=0)) D
  1. .I 'HDRDISP D ; if the header is not already displayed, display it.
  1. ..S FLDTITL="Field"_$J("",15)_"File Name"_$J("",11)_"Field Name"_$J("",15)_"Audit"_$J("",14)
  1. ..I DISPLAY=1 D
  1. ...S VALMHDR(1)=$J("",26)_"List of Audited Fields"
  1. ...S VALMHDR(2)=" Asterisk (*) beside field name denotes required field for audit"
  1. ...D CHGCAP^VALM("HEADER",FLDTITL)
  1. ..I DISPLAY=-1 D
  1. ...D ADD^LRJSAU(.VALMCNT," "_FLDTITL)
  1. ...S X=" ",$P(X,"-",73)=""
  1. ...D ADD^LRJSAU(.VALMCNT,X)
  1. ..S HDRDISP=1 ; flag the header as displayed
  1. ..Q
  1. .S X=" "_60_"."_$S(XFILENUM=60&($E(LRAFLDS)="."):$P(LRAFLDS,".",2),XFILENUM=60:LRAFLDS,1:XFILENUM)
  1. .I XFILENUM'=60 S X=X_$S($E(LRAFLDS)'=".":".",1:"")_LRAFLDS
  1. .S X=$E(X_SPACE,1,17)
  1. .S X=X_$E($$GFILENM(XFILENUM)_SPACE,1,19)_" "
  1. .S X=X_$E($$GFLDNM(XFILENUM,LRAFLDS)_$S('$G(XNEW):"*",1:" ")_SPACE,1,27)
  1. .S XAUD=$$GET1^DID(XFILENUM,LRAFLDS,"","AUDIT")
  1. .S X=X_" "_$S(XAUD]"":XAUD,1:"** NOT AUDITED **")
  1. .D ADD^LRJSAU(.VALMCNT,X)
  1. Q
  1. ;
  1. ISAUDON(FILENUM,FLDNUM) ; -- is audit on for the given file/field number
  1. Q ($$GET1^DID(FILENUM,FLDNUM,"","AUDIT")["YES, ALWAYS")
  1. ;
  1. GFLDSB(FILENUM,FLDNUM) ;if field is multiple, return subfile #
  1. N LRX
  1. D FIELD^DID(FILENUM,FLDNUM,"","SPECIFIER","LRX")
  1. Q +$G(LRX("SPECIFIER"))
  1. ;
  1. GFILENM(FILENUM) ; -- get the file/subfile name for given file ien
  1. N LRX,LRE
  1. I $D(^DIC(FILENUM,0)) D ; Not a subfile
  1. .S LRX=$$GET1^DID(FILENUM,"","","NAME","LRX","LRE")
  1. E D ; subfile
  1. .S LRX=$O(^DD(FILENUM,0,"NM",""))
  1. Q $G(LRX)
  1. ;
  1. GFLDNM(FILENUM,FLDNUM) ; -- get the field name for given file/sub-file ien and field number
  1. N OUT
  1. D FIELD^DID(FILENUM,FLDNUM,"","LABEL","OUT")
  1. Q $G(OUT("LABEL"))
  1. ;
  1. GMONLIST(FILENUM,MONLIST) ; return the list of fields to be monitored from configuration file.
  1. N ARR,IEN,FLDNUM,FLDLIST,NODE,VAR,XFILENUM
  1. S IEN=$O(^LABAUD(64.9178,"B",FILENUM,0))
  1. D GETS^DIQ(64.9178,IEN_",","**","","ARR")
  1. S VAR="ARR"
  1. S MONLIST=""
  1. S NODE=$NAME(@VAR@(64.9178))
  1. F S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,3)'=.01 D
  1. .S FLDNUM=$P(@NODE,"^",1)
  1. .S XFILENUM=$S(FLDNUM'[",":60,1:$P(FLDNUM,","))
  1. .S MONLIST(XFILENUM)=$S($D(MONLIST(XFILENUM)):MONLIST(XFILENUM)_";",1:"")_$S(FLDNUM'[",":FLDNUM,1:$P(FLDNUM,",",2))
  1. Q
  1. ;
  1. ; if '^' out of prompts, allow exit/added parameter
  1. FILENUM(LROUT) ;
  1. K DIR
  1. S LROUT=0
  1. S FILENUM=60
  1. D GIENLIST(FILENUM,.IENLIST)
  1. I $D(DTOUT)!$D(DUOUT) S LROUT=1 Q
  1. I '$D(IENLIST) W !," ALL TESTS"
  1. ;Select FROM DATE
  1. S LRFRDT=$$DATEENT("Select Start date: ",,"-NOW")
  1. I LRFRDT<1 S:$D(DTOUT)!$D(DUOUT) LROUT=1 Q
  1. S LRTODT=$$DATEENT(" Select End date: ",LRFRDT,"-NOW")
  1. I $D(DTOUT)!$D(DUOUT) S LROUT=1 Q
  1. I +LRTODT<1 S:$D(DTOUT)!$D(DUOUT) LROUT=1 Q
  1. D MSG2
  1. Q
  1. ;
  1. GIENLIST(FILENUM,IENLIST) ; get list of entries (ien) For a given file into IENLIST array.
  1. N DIC,X,Y,U
  1. K IENLIST
  1. S DIC("0")="AEQM"
  1. S DIC=FILENUM
  1. S Y=-1
  1. F D Q:+Y=-1
  1. .D ^DIC
  1. .S:+Y'=-1 IENLIST(+Y)=""
  1. Q
  1. ;
  1. DATEENT(LRPRMPT,LRBD,LRED) ;Prompt for extract date
  1. ;INPUT
  1. ; LRPRMPT - Prompt displayed to user
  1. ; LRBD - Begin date of range
  1. ; LRED - End date of range
  1. ;
  1. ;RETURN
  1. ; LRDT
  1. ; SUCCESS: FILEMAN INTERNALLY FORMATED DATE
  1. ; FAILURE: -1
  1. ;
  1. N LRDT,LRGOOD,X,Y
  1. S LRGOOD=0
  1. S:+$G(LRED)>0 %DT(0)=LRED
  1. S:$G(LRED)["NOW" %DT(0)=LRED
  1. S %DT("A")=LRPRMPT
  1. S %DT("B")="TODAY" ;Default for [Start] date entry
  1. S %DT="AEPST"
  1. D:LRPRMPT["Start" ^%DT ;Prompt for Start date
  1. ;
  1. ;Prompt for End date with conditions
  1. I LRPRMPT["End" D
  1. .F Q:LRGOOD D
  1. ..S %DT("B")="NOW" ;Change default for End Date entry
  1. ..D ^%DT
  1. ..W:((Y<LRBD)&(X'="^")&('$D(DTOUT))) " ??",!," End date must follow Begin date!",!
  1. ..S:((Y>LRBD)!(Y=LRBD)!($D(DTOUT))!(X="^")) LRGOOD=1
  1. S LRDT=Y
  1. K Y,%DT
  1. Q LRDT
  1. ;
  1. MSG2 ; -- set default message
  1. N LREND,LRBEGIN,LRAUTMSG
  1. S LRBEGIN=$$GET^XPAR("SYS","LRJ LSRP AUF60 LAST START DATE",1,"Q")
  1. S LREND=$$GET^XPAR("SYS","LRJ LSRP AUF60 LAST END DATE",1,"Q")
  1. I (LRBEGIN'="")!(LREND'="") D
  1. .S LRAUTMSG="Last Task Rpt "_$S(LRBEGIN'="":$$FMTE^XLFDT(LRBEGIN),1:"undeed")_" - "_$S(LREND'="":$$FMTE^XLFDT(LREND),1:"undefined")
  1. I LRBEGIN="",LREND="" D
  1. .S LRAUTMSG="Tasked Report has not run!"
  1. S VALMSG=LRAUTMSG
  1. Q
  1. ;
  1. GIOP(DEVICE) ; -- return the device if exist and it is not FORCED to queue, otherwise return ""
  1. N POP
  1. S IOP=DEVICE
  1. S %ZIS="N" ; so the ^%ZIS call does not open the device.
  1. D ^%ZIS ; return the characteristics of the device.
  1. I POP=1 DO ; does the device exist?
  1. .S DEVICE=""
  1. E D
  1. .; is the queuing forced forced for this device?
  1. .I $P(^%ZIS(1,IOS,0),"^",12)=1 S DEVICE=""
  1. ;
  1. D ^%ZISC ; restore the device variables
  1. Q DEVICE
  1. ;
  1. SETTMP(D0,LRIEN,LRDT,LRUSER,LRFLDNM,LRFNUM,LROLD,LRNEW) ;
  1. ; ^TMP("LRDATA",$J,OLD/NEW determination,test ien,data element)=data element value
  1. I $D(IENLIST),'$D(IENLIST(+LRIEN)) Q ; test is not one of those selected
  1. N Q
  1. F Q="LRIEN","LRDT","LRUSER","LRFLDNM","LRFNUM","LROLD","LRNEW" S ^TMP("LRDATA",$J,D0,Q)=@Q
  1. ;determine if new test was entered
  1. I LRFLDNM="NAME",LROLD["<no previous",LRIEN=+LRIEN S ^TMP("LRDATA",$J,"NEW",LRIEN,D0)=LRDT Q
  1. I $D(^TMP("LRDATA",$J,"NEW",+LRIEN)) D
  1. .;Check for within 2 hr window
  1. .N DIFF,X1,X2
  1. .S X1=+$O(^TMP("LRDATA",$J,"NEW",+LRIEN,0)),X1=$G(^TMP("LRDATA",$J,"NEW",+LRIEN,X1))
  1. .S X2=LRDT
  1. .S DIFF=$$FMDIFF^XLFDT(X2,X1,2) ; find difference in seconds (2 hrs = 7200 secs)
  1. .I DIFF'>7200 S ^TMP("LRDATA",$J,"NEW",+LRIEN,D0)=""
  1. Q
  1. ;