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

DGAUDIT1.m

Go to the documentation of this file. 
  1. DGAUDIT1 ; ISL/DKA - Dataset 1 of VAS VistA Audit Solution ; 03 Aug 2021  1:05 PM
  1.  ;;5.3;Registration;**964,1097,1108,1120**;Aug 13, 1993;Build 6
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Reference to ^VA(200 in ICR #1262
  1.  ; Reference to FILE^DID  in ICR #2052
  1.  ; Reference to GETS^DIQ  in ICR #2056
  1.  ; Reference to ^DIA in ICR #2602
  1.  ; Reference to ENCODE^XLFJSON in ICR #6682
  1.  ; Reference to ^DD(9000001 in ICR #7187
  1.  ; Reference to ^DIC in ICR #10006
  1.  ; Reference to FILE^DICN in ICR #10009
  1.  ; Reference to EN^DIQ1 in ICR #10015
  1.  ; Reference to ^DIE in ICR #10018
  1.  ; Reference to $$FMTH^XLFDT in ICR #10103
  1.  ; Reference to $$FMTHL7^XLFDT in ICR #10103
  1.  ; Reference to $$GETICN^MPIF001 in ICR #2701
  1.  ; 
  1.  ; Local process variable DGAUDMAX NEWed in calling routine ^DGAUDIT
  1.  ; Local process variable DGAUDSHUT NEWed in calling routine ^DGAUDIT
  1.  ; Local process variable DGAUDSTOP NEWed in calling routine ^DGAUDIT
  1.  ; Local process variable DGBATSIZE NEWed in calling routine ^DGAUDIT
  1.  ; Local process variable DGDONE NEWed in calling routine ^DGAUDIT
  1.  ;
  1.  Q  ; No entry from top
  1.  ;
  1.  ;
  1. NEWAUDEX ; Export newly added AUDIT (#1.1) records
  1.  ; Loop through the File Numbers in ^DIA()
  1.  ; If there's a Patient-Related File that doesn't exist in DG VAS EXPORT,  ; FLS Changed VSRA TO VAS 3/16/2021
  1.  ; then add a new record to that File and set the LAST RECORD EXPORTED to 0.
  1.  ; Start with the next record following the LAST RECORD EXPORTED recorded in DG VAS EXPORT (#46.4)  ; FLS Changed VSRA TO VAS 3/16/2021
  1.  N AUDGREF,CNTREC,D,D0,DA,DD,DIC,DICR,DIE,DIU,DIV,DO,DR,DTOUT,DUOUT,FILENUM,GREF,IEN,REC,RECDATA,DGABORT
  1.  N VD,VM,X,Y,DGSEC,DGSTOPFLG,DGDEBUGON
  1.  L +^DGAUDIT1(0):1 Q:'$T
  1.  S DGDEBUGON=$$GET^XPAR("ALL","DG VAS DEBUGGING FLAG") ; Changed XPAR names from VSRA to VAS 3/17/21
  1.  S AUDGREF=$NA(^DIA),GREF=$NA(^DGAUDIT1)
  1.  S (CNTREC,FILENUM,DGABORT)=0
  1.  F  S FILENUM=$O(@AUDGREF@(FILENUM)) Q:'FILENUM!$G(DGAUDSTOP)!'$G(DGAUDSHUT)!$$S^%ZTLOAD!$G(DGDONE)!$G(DGABORT)  D
  1.  . S DGAUDSHUT=$$GET1^DIQ(46.5,1,.02,"I")                ; Check send switch. NEWed in DGAUDIT
  1.  . N LASTDIA,RECDATA,SWITCHDT,EXPRTIEN,RECDATE
  1.  . S LASTDIA=$$GET1^DIQ(1.1,FILENUM,.03) Q:(LASTDIA<1)
  1.  . Q:'$$PATREL(FILENUM)
  1.  . K DIC S DIC="^DGAUDIT1(",X=FILENUM D ^DIC D:Y<1  Q:Y'>0
  1.  . . K DIC S DIC="^DGAUDIT1(",DIC(0)="",DIC("DR")=".02///0;.04///"_$$NOW^XLFDT,X=FILENUM D FILE^DICN
  1.  . ; Y now contains the IEN of DG AUDIT EXPORT, whether newly created or not.
  1.  . S EXPRTIEN=+Y S REC=+$$GET1^DIQ(46.4,EXPRTIEN,.02) S:'REC REC=$O(@AUDGREF@(FILENUM,+LASTDIA),-1) S:'REC REC=LASTDIA
  1.  . ; If the REC is not in the AUDIT file, reset the REC to the next-to-last IEN in the AUDIT file.
  1.  . I '$D(@AUDGREF@(FILENUM,+REC,0)) S REC=$O(@AUDGREF@(FILENUM,+LASTDIA),-1) Q:'REC
  1.  . ; If starting record isn't already set to the last record in ^DIA, and the record's audit date is prior to the switch date, reset REC to last IEN in the AUDIT file.
  1.  . I REC'=LASTDIA S RECDATA=$G(@AUDGREF@(FILENUM,REC,0)),RECDATE=$P(RECDATA,"^",2),SWITCHDT=$P($G(^DGAUDIT1(EXPRTIEN,0)),"^",4) D  Q:'REC
  1.  .. I SWITCHDT'?7N.E S SWITCHDT=$$NOW^XLFDT N DGFDA,DGFILERR S DGFDA(46.4,EXPRTIEN_",",.04)=SWITCHDT D FILE^DIE(,"DGFDA","DGFILERR")
  1.  .. Q:RECDATE>SWITCHDT                                                              ; Record's audit date is after send switch date, use this record
  1.  .. S RECDATE=0 F  Q:$G(RECDATE)  S REC=$O(^DIA(FILENUM,REC)) Q:'REC  D  Q:'REC     ; Find next audit record
  1.  ... S RECDATA=$G(@AUDGREF@(FILENUM,REC,0)),RECDATE=$P(RECDATA,"^",2)
  1.  ... I SWITCHDT?7N.E,(RECDATE<SWITCHDT) S RECDATE="" Q                              ; Check audit date, quit and move to next record if before send switch date
  1.  ... S REC=$O(^DIA(FILENUM,REC),-1)                                                 ; Found audit date>send switch date, set REC=previous record ($O will start with this record)
  1.  . F  S REC=$O(@AUDGREF@(FILENUM,REC)) Q:'REC!$G(DGAUDSTOP)!'$G(DGAUDSHUT)!$G(DGABORT)!(REC>LASTDIA)  D
  1.  .. S DGAUDSHUT=$$GET1^DIQ(46.5,1,.02,"I")                ; Check send switch. NEWed in DGAUDIT
  1.  .. S CNTREC=CNTREC+($$FMAUD(FILENUM,REC)>0)
  1.  .. K DIC S DIC="^DGAUDIT1(",X=FILENUM D ^DIC
  1.  .. K DIE,DR,DA S DIE=46.4,DA=+Y,DR=".02///"_REC_";.03///"_$TR($G(@AUDGREF@(FILENUM,REC,0)),U,"%") D ^DIE
  1.  .. I $$PENDING>(DGAUDMAX/4) D EXPORT3^DGAUDIT(.DGABORT)  ; If queue is more than 25% full, clear it out by sending all queued records
  1.  .. S:$$FROZEN^DGAUDIT(70) DGABORT=1   ; Queue should be empty now - if queue remains more than 70% full, there's a problem.
  1.  . I DGDEBUGON D
  1.  .. D DBEMAIL("NEWAUDEX^DGAUDIT1")
  1.  .. S DGDEBUGON=0
  1.  .. D EN^XPAR("SYS","DG VAS DEBUGGING FLAG",1,DGDEBUGON)  ; Turn debug mode off. ; Changed XPAR names from VSRA to VAS 3/17/21
  1.  . I $$PENDING>+$G(DGBATSIZE) D EXPORT3^DGAUDIT(.DGABORT) ; Clear out queue by sending all records for file FILENUM from ^DIA
  1.  . S:$$FROZEN^DGAUDIT(70) DGABORT=1   ; Queue should be empty now - if queue remains more than 70% full, there's a problem.
  1.  L -^DGAUDIT1(0)
  1.  Q
  1.  ;
  1. FMAUD(FILENUM,AUDIEN) ; Send the data for a given AUDIT (#1.1) record
  1.  N AUDARR,JSON,C,DA,DATETIME,DIA,DIC,DIQ,DR,ERR,FILEDATA,N,X,DGVARR,DGVDATA,DGVDFN,DGVDUZ,DGVREF,DGVMSG,DGVOFFN,DGVINST,DGAUDSTANUM,DGMVI,DGCTRL,DCCI
  1.  S:'$G(DGAUDMAX) DGAUDMAX=$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES")
  1.  Q:$$PENDING'<DGAUDMAX
  1.  S DIA=FILENUM ; This is a special variable used for accessing AUDIT entries
  1.  S DIC="^DIA(DIA,",DA=AUDIEN,DIQ="DGVDATA"
  1.  ; Get the fields for which we want both Internal and External values
  1.  S DIQ(0)="IEN",DR=".02;.04;4.1"
  1.  D EN^DIQ1
  1.  I '$D(DGVDATA) Q -1
  1.  ;
  1.  S DGVREF=$NA(@$Q(DGVDATA),2)
  1.  S DIQ(0)="N" ; DICMX allows the lookup on Field 2.14 without <UNDEFINED>
  1.  S DR=".01;.03;.05;.06;1;1.1;2;2.1;2.2;2.9;3;3.1;3.2;4.2"
  1.  D EN^DIQ1
  1.  F DCCI=0:1:31 S DGCTRL=$G(DGCTRL)_$c(DCCI)  ; Build string of non-printable control characters
  1.  F DCCI=127:1:159 S DGCTRL=$G(DGCTRL)_$c(DCCI)
  1.  ;
  1.  ; If the AUDIT File can't identify the Patient,
  1.  ; Then see if the Field being changed is the .01 Field and has an Old Value but a blank New Value
  1.  ; and the Field Type is a Pointer to the PATIENT File (#2) or the PATIENT/IHS File (#9000001),
  1.  ; and if so, then set the Patient value to the DFN from the OLD VALUE field.
  1.  ; If we still don't have a Patient, then Quit.
  1.  ; 
  1.  I $G(@DGVREF@(2.9))="",$G(@DGVREF@(.03))=".01",$G(@DGVREF@(2.2))["P2'"!($G(@DGVREF@(2.2))["P9000001'"),$G(@DGVREF@(3))="<deleted>" S @DGVREF@(2.9)=$G(@DGVREF@(2.1))
  1.  I $G(@DGVREF@(2.9))="" Q -2
  1.  I $$ANON($G(@DGVREF@(.04,"I"))) Q 0
  1.  S DGVARR=$NA(AUDARR("data","HEADER"))
  1.  S DGVDFN=$G(@DGVREF@(2.9))
  1.  ; These are the additional fields that we want to send with each record to the Audit Solution
  1.  S DATETIME=$G(@DGVREF@(.02,"I"))
  1.  I DATETIME'="" D
  1.  . S @DGVARR@("DateTime")=$$FMTHL7^XLFDT(DATETIME)
  1.  . ;S @DGVARR@("Week")=$SYSTEM.SQL.WEEK(+$$FMTH^XLFDT(DATETIME))
  1.  . ;S @DGVARR@("Year")=$SYSTEM.SQL.YEAR(+$$FMTH^XLFDT(DATETIME))
  1.  . S @DGVARR@("Week")=$$WEEK^DGAUDIT1($P(DATETIME,"."))
  1.  . S @DGVARR@("Year")=+$$FMTE^XLFDT(DATETIME,7)
  1.  S @DGVARR@("RequestType")=$S($G(@DGVREF@(.05))="Added Record":"CREATE",$G(@DGVREF@(.03))=.01&($G(@DGVREF@(3))="<deleted>"):"DELETE",1:"UPDATE")
  1.  S @DGVARR@("SchemaType")="FMAUDIT"
  1.  S DGVARR=$NA(AUDARR("data","HEADER","Patient"))
  1.  S @DGVARR@("DFN")=$TR(DGVDFN,DGCTRL)
  1.  S DGMVI=$$GETICN^MPIF001(DGVDFN),DGMVI=$S(DGMVI>0:DGMVI,1:"")
  1.  S @DGVARR@("MVI")=$TR(DGMVI,DGCTRL)
  1.  S @DGVARR@("PatientName")=$TR($$GET1^DIQ(2,DGVDFN,.01),DGCTRL)
  1.  S @DGVARR@("SSN")=$TR($$GET1^DIQ(2,DGVDFN,.09),DGCTRL)
  1.  S @DGVARR@("INITPLUS4")=$TR($$GET1^DIQ(2,DGVDFN,.0905),DGCTRL)
  1.  S @DGVARR@("DOB")=$TR($$FMTHL7^XLFDT($$GET1^DIQ(2,DGVDFN,.03,"I")),DGCTRL)
  1.  ;
  1.  S DGVARR=$NA(AUDARR("data","HEADER","User"))
  1.  S (DGVDUZ,@DGVARR@("DUZ"))=$TR($G(@DGVREF@(.04,"I")),DGCTRL)
  1.  S @DGVARR@("UID")=$TR($$GET1^DIQ(200,$G(@DGVREF@(.04,"I")),205.4),DGCTRL)
  1.  S @DGVARR@("UserName")=$TR($G(@DGVREF@(.04,"E")),DGCTRL)
  1.  S @DGVARR@("Title")=$TR($$GET1^DIQ(200,$G(@DGVREF@(.04,"I")),8),DGCTRL)
  1.  ;
  1.  S DGVARR=$NA(AUDARR("data","HEADER","Location"))
  1.  S:DGVDUZ'="" DGVINST=$O(^VA(200,DGVDUZ,2,"AX1",1,"")) ; Get User's Default Division
  1.  S:$G(DGVINST)="" DGVINST=$$GET1^DIQ(8989.3,1,217,"I") ; Default Institution
  1.  S DGVOFFN=$TR($$GET1^DIQ(4,DGVINST,100),DGCTRL) ; Official VA Name
  1.  S @DGVARR@("Site")=$S(DGVOFFN'="":$TR(DGVOFFN,DGCTRL),1:$TR($$GET1^DIQ(8989.3,1,217),DGCTRL)) ; External value of the Default Institution
  1.  S @DGVARR@("StationNumber")=$TR($$GET1^DIQ(4,DGVINST,99),DGCTRL) ; Station Number for the Default Institution
  1.  ;
  1.  S DGVARR=$NA(AUDARR("data","SCHEMA"))
  1.  S @DGVARR@("FILE NUMBER")=FILENUM
  1.  D FILE^DID(FILENUM,,"NAME","FILEDATA")
  1.  S @DGVARR@("FILE NAME")=$G(FILEDATA("NAME"),"null")
  1.  ; These are fields supplied by the AUDIT Data Dictionary (#1.1) that we have chosen to send.
  1.  S @DGVARR@("RECORD ADDED")=$TR($G(@DGVREF@(.05),"null"),DGCTRL)
  1.  S @DGVARR@("ACCESSED")=$TR($G(@DGVREF@(.06),"null"),DGCTRL)
  1.  S @DGVARR@("FIELD NAME")=$TR($G(@DGVREF@(1.1),"null"),DGCTRL)
  1.  S @DGVARR@("OLD VALUE")=$TR($G(@DGVREF@(2),"null"),DGCTRL)
  1.  S @DGVARR@("NEW VALUE")=$TR($G(@DGVREF@(3),"null"),DGCTRL)
  1.  S @DGVARR@("MENU OPTION USED")=$TR($G(@DGVREF@(4.1,"E"),"null"),DGCTRL)
  1.  S @DGVARR@("PROTOCOL or OPTION USED")=$TR($G(@DGVREF@(4.2),"null"),DGCTRL)
  1.  ;
  1.  D PAYLOAD(.JSON,.AUDARR,DGVARR,FILENUM,AUDIEN)
  1.  Q 1
  1.  ;
  1.  ;
  1. PAYLOAD(DATA,HDRDATA,DGVARR,FILENUM,AUDIEN) ; Take ARRAY and send it the Audit Solution
  1.  Q:'$$GET1^DIQ(46.5,1,.02,"I")  ; Audit flag blank/0=do not add to queue, 1=add to queue, 2=add to queue
  1.  N DA,DO,DIC,X,Y,DGAUDECNT,LOCKED,DGFDA,DGNOWDTM,DGJSONID,JSONERR,DGAUDIEN,DGAUDJSON,TMPJSON,DGFMERR
  1.  ;
  1.  S DGNOWDTM=$$NOW^XLFDT
  1.  S DGJSONID=+$G(FILENUM)_"."_+$G(AUDIEN)_"."_DGNOWDTM
  1.  S DGAUDECNT="+1,"
  1.  S DGVARR=$NA(HDRDATA("id"))
  1.  S @DGVARR=DGJSONID  ;DGNOWDTM_"."_$$HL7TFM^XLFDT($G(HDRDATA("data","HEADER","DateTime")))   ; Record ID - File 46.3 IEN_"."_FMDATETIME
  1.  ;
  1.  N DGSTATION,DGSITENAM,DGSITEIEN
  1.  S DGVARR=$NA(HDRDATA("station"))
  1.  S DGSTATION=$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  S @DGVARR=DGSTATION
  1.  S DGVARR=$NA(HDRDATA("site"))
  1.  S DGSITEIEN=$$FIND1^DIC(4,,"X",DGSTATION,"D")
  1.  S DGSITENAM=$$GET1^DIQ(4,DGSITEIEN,.01)
  1.  S @DGVARR=DGSITENAM
  1.  ;
  1.  D ENCODE^XLFJSON($NA(@DGVARR,0),"DGAUDJSON","JSONERR")
  1.  I '$G(JSONERR) D DECODE^XLFJSON("DGAUDJSON","TMPJSON","JSONERR")
  1.  ;
  1.  S DGFDA(46.3,DGAUDECNT,.01)=DGNOWDTM
  1.  S DGFDA(46.3,DGAUDECNT,.02)="UPDATE"
  1.  S DGFDA(46.3,DGAUDECNT,.03)=$$HL7TFM^XLFDT($G(HDRDATA("data","HEADER","DateTime")))
  1.  S DGFDA(46.3,DGAUDECNT,.04)=$G(HDRDATA("data","HEADER","Patient","DFN"))
  1.  S DGFDA(46.3,DGAUDECNT,.05)=$G(HDRDATA("data","HEADER","User","DUZ"))
  1.  S DGFDA(46.3,DGAUDECNT,.06)=$G(HDRDATA("data","SCHEMA","MENU OPTION USED"))
  1.  S DGFDA(46.3,DGAUDECNT,.07)=$G(HDRDATA("data","SCHEMA","FILE NUMBER"))
  1.  S DGFDA(46.3,DGAUDECNT,.08)=$G(HDRDATA("data","HEADER","Location","StationNumber"))
  1.  S DGFDA(46.3,DGAUDECNT,1)=DGAUDJSON(1)
  1.  ;
  1.  I ($L($G(DGFDA(46.3,DGAUDECNT,1)))<30)!$G(JSONERR(0)) D  Q
  1.  . M DGFDA(46.3,DGAUDECNT,1)=HDRDATA
  1.  . I $G(JSONERR(0)) S JSONERR=0 F  S JSONERR=$O(JSONERR(JSONERR)) Q:'JSONERR  S DGFDA(46.3,DGAUDECNT_",",1,"JSON ERROR",.999+JSONERR)=$G(JSONERR(JSONERR))
  1.  . D BADJSON^DGAUDIT2(0,+$G(DGAUDKPX),.DGFDA)
  1.  D UPDATE^DIE("S","DGFDA","DGAUDIEN","DGFMERR") S DGAUDIEN=$G(DGAUDIEN(1))
  1.  I 'DGAUDIEN!'$L($G(^DGAUDIT(+DGAUDIEN,1))) D
  1.  . M DGFDA(46.3,DGAUDECNT,1)=HDRDATA
  1.  . I $D(DGFMERR("DIERR",1,"TEXT")) S DGFDA(46.3,DGAUDECNT,1,"JSON ERROR",1.999)="FileMan Filer Error: "_$G(DGFMERR("DIERR",1,"TEXT",1))
  1.  . D BADJSON^DGAUDIT2(+$G(DGAUDIEN),+$G(DGAUDKPX),.DGFDA)
  1.  Q
  1.  ;
  1. PATREL(FILENUM) ; Return 1 if this is a patient-related File
  1.  Q $D(^DD(2,0,"PT",FILENUM))>0!($D(^DD(9000001,0,"PT",FILENUM))>0)
  1.  ;
  1. DBEMAIL(TAG) ; send email if debugging turned on
  1.  N DGVOFFN,DGVDUZ,DGSUBJ,DGMSG,DGXMTO,DGGLO,DGGLB,DGXMINSTR,DGVINST,DGSITE,DGAUDSTANUM,DGNOW,DGEMAIL  ; JPN ADDED 03/31/21
  1.  N DGSQ,DGSUB,DGVAR,Y,%,DGINST
  1.  S DGNOW=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S DGVDUZ=$G(DUZ)
  1.  S:DGVDUZ'="" DGVINST=$O(^VA(200,DGVDUZ,2,"AX1",1,"")) ; Get User's Default Division
  1.  S DGAUDSTANUM=$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  D F4^XUAF4(DGAUDSTANUM,.DGINST)
  1.  S DGSITE=$G(DGINST("VA NAME"))
  1.  S DGSUBJ=TAG_" sent from "_$G(DGSITE)_" - "_$G(DGAUDSTANUM)
  1.  S DGSUBJ=$E(DGSUBJ,1,65)
  1.  S DGMSG(2)=""
  1.  S DGMSG(3)=" Name: "_$G(DGSITE)
  1.  S DGMSG(4)=" Station#: "_+$$STA^XUAF4($$KSP^XUPARAM("INST"))
  1.  S DGMSG(5)=" Domain: "_$G(^XMB("NETNAME"))
  1.  S DGMSG(6)=" Date/Time: "_DGNOW
  1.  S DGMSG(7)=" By: "_$P($G(^VA(200,DUZ,0)),U,1)
  1.  S DGMSG(8)=""
  1.  S DGMSG(9)=""
  1.  S DGSQ=9
  1.  S %="" F  S %=$O(@%) Q:%=""  S DGSQ=$G(DGSQ)+1,DGMSG(DGSQ)=%_"="_$G(@%)
  1.  ;Copy mesage to OIT team?
  1.  S DGXMTO(DUZ)=""
  1.  S DGEMAIL=$$GET^XPAR("ALL","DG VAS MONITOR GROUP")           ;JPN ADDED 3/31/21
  1.  S DGXMTO("G."_DGEMAIL)=""                                    ;JPN ADDED 3/31/21
  1.  S DGXMINSTR("FROM")="noreply.domain.ext"
  1.  ;
  1.  D SENDMSG^XMXAPI(DUZ,DGSUBJ,"DGMSG",.DGXMTO,.DGXMINSTR)
  1.  Q:'$D(^TMP("XMERR",$J))    ; no email problems
  1.  ;
  1.  D MES^XPDUTL("MailMan reported a problem trying to send the notification message.")
  1.  D MES^XPDUTL(" ")
  1.  S (DGGLO,DGGLB)="^TMP(""XMERR"","_$J
  1.  S DGGLO=DGGLO_")"
  1.  F  S DGGLO=$Q(@DGGLO) Q:DGGLO'[DGGLB  D MES^XPDUTL(" "_DGGLO_" = "_$G(@DGGLO))
  1.  D MES^XPDUTL(" ")
  1.  Q
  1.  ;
  1. ANON(DGDUZ) ; Check to see if the user fits the definition of an anoymous user
  1.  ; Currently checking users with user types below
  1.  N RTN,UNAME
  1.  S RTN=0,UNAME=$$GET1^DIQ(200,DGDUZ,.01)
  1.  I DGDUZ="" Q 1
  1.  I $$ACTIVE^XUSAP(DGDUZ) D
  1.  . ;I $SYSTEM.SQL.UPPER(UNAME)["ANONYMOUS" S RTN=1
  1.  . I $$UP^XLFSTR(UNAME)["ANONYMOUS" S RTN=1
  1.  . I $$USERTYPE^XUSAP(DGDUZ,"CONNECTOR PROXY") S RTN=1
  1.  . I $$USERTYPE^XUSAP(DGDUZ,"APPLICATION PROXY") S RTN=1
  1.  Q RTN
  1.  ;
  1. WEEK(FMDATE) ; Accept Fileman Date, Return Week
  1.  N DAYOFYR,YRBEGDOW,YRBEG,WEEK
  1.  S WEEK=""
  1.  Q:'$G(FMDATE) ""
  1.  S FMDATE=$P(FMDATE,".") Q:'(FMDATE?7N) ""
  1.  S YRBEG=$E(FMDATE,1,3)_"0101"
  1.  S YRBEGDOW=$$DOW^XLFDT(YRBEG,1)
  1.  S DAYOFYR=$$FMDIFF^XLFDT(FMDATE,$$FMADD^XLFDT(YRBEG+(6-YRBEGDOW)))  ; Partial Week at beginning of year - add 1 to week below
  1.  S WEEK=(DAYOFYR/7)+1 S WEEK=$S($P(WEEK,".",2):WEEK\1+1,1:WEEK)
  1.  I (WEEK>53)!(WEEK<1) S WEEK=""
  1.  Q WEEK
  1.  ;
  1. ESCAPE(INPUT) ; Escape XML characters from INPUT
  1.  N ESCHAR,ESCAPED,CHAR,CHARARY,POS
  1.  S INPUT=$G(INPUT),ESCAPED=""
  1.  F CHAR="':'","&:&","<:<",">:>" S CHARARY($P(CHAR,":"))=$P(CHAR,":",2)
  1.  F POS=1:1:$L(INPUT) S CHAR=$E(INPUT,POS) D
  1.  .I $D(CHARARY(CHAR)) S ESCAPED=$G(ESCAPED)_CHARARY(CHAR) Q
  1.  .S ESCAPED=$G(ESCAPED)_CHAR
  1.  Q ESCAPED
  1.  ;
  1. GETTEXT(ERRARRAY) ;
  1.  ; @DESC Gets the error text from the array
  1.  ;
  1.  ; @ERRARRAY Error array stores error in format defined by web service product.
  1.  ;
  1.  ; @RETURNS Error info as a single string
  1.  ;
  1.  NEW DGAUD
  1.  ;
  1.  ; Loop through the text subscript of error array and concatenate
  1.  SET DGAUD("errorText")=""
  1.  SET DGAUD("I")=""
  1.  FOR  SET DGAUD("I")=$ORDER(ERRARRAY("text",DGAUD("I"))) QUIT:DGAUD("I")=""  DO
  1.  . SET DGAUD("errorText")=DGAUD("errorText")_ERRARRAY("text",DGAUD("I"))
  1.  . QUIT
  1.  ;
  1.  QUIT DGAUD("errorText")
  1.  ;
  1. ERRSPMSG(DGRESPERR,DGRESPETXT) ; 
  1.  ; Input : DGRESPERR (Required) - response error from Post call
  1.  ; Return: response code/txt (ex: DGERR(400) from Init)_response code/msg (ex: ADDRVAL###)
  1.  N DGERRCODE,DGEMSG
  1.  S DGERRCODE=DGRESPERR.code
  1.  DO ERR2ARR^XOBWLIB(.DGRESPERR,.DGRESPETXT)
  1.  ; Example:
  1.  ;  S DGRESPETXT("errorType")="HTTP"
  1.  ;  S DGRESPETXT("statusLine")="HTTP/1.1 504 Gateway Timeout"
  1.  ;  S DGRESPETXT("text")=1
  1.  ;  S DGRESPETXT("text",1)={"message":"Unable to parse data. Not JSON format"}
  1.  S DGEMSG=$G(DGRESPETXT("text",1))
  1.  I DGEMSG="" S DGEMSG=DGRESPETXT("statusLine")
  1.  S DGERR(DGERRCODE)=DGERRCODE_$S($L(DGEMSG)>1:DGEMSG,1:" VAS Service Error.")
  1.  Q DGERR(DGERRCODE)
  1.  ;
  1. PENDING() ; Return number of entries in queue
  1.  N DGQIEN,DGQCNT
  1.  S DGQCNT=0
  1.  S DGQCNT=$P(^DGAUDIT(0),U,4)
  1.  ;I ($G(DGQCNT)'>0),$O(^DGAUDIT(0)) S (DGQIEN,DGQCNT)=0 F  S DGQIEN=$O(^DGAUDIT(DGQIEN)) Q:'DGQIEN
  1.  S (DGQIEN,DGQCNT)=0 F DGQCNT=0:1 S DGQIEN=$O(^DGAUDIT(DGQIEN)) Q:'DGQIEN
  1.  Q DGQCNT
  1.  ;
  1. GENERR(DGAUDERR,DGALTSUB) ; General Error, DGAUDERR specific text
  1.  N DGSRVID,DGSSLPORT,DGAUDNUM,DGAUDER2,DGAUDDATA
  1.  S DGAUDER2=1
  1.  S DGSRVID=$$FIND1^DIC(18.12,,"B","DG VAS WEB SERVER")
  1.  S DGAUDER2(DGAUDER2)="Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT),DGAUDER2=DGAUDER2+1
  1.   ; If SSL enabled PORT=$$GET1^DIQ(18.12,SRVID,3.03)
  1.  S DGSSLPORT=$$GET1^DIQ(18.12,DGSRVID,3.03)
  1.  I $G(DGSRVID) D
  1.  . S DGAUDER2(DGAUDER2)="Error from DG VAS WEB SERVER: "_$$GET1^DIQ(18.12,DGSRVID,.04)_" on port: "_$S($G(DGSSLPORT):DGSSLPORT,1:$$GET1^DIQ(18.12,DGSRVID,.03))
  1.  . S DGAUDER2=DGAUDER2+1
  1.  . S DGAUDER2(DGAUDER2)="",DGAUDER2=DGAUDER2+1
  1.  S DGAUDERR=0 F  S DGAUDERR=$O(DGAUDERR(DGAUDERR)) Q:'DGAUDERR  S DGAUDER2(DGAUDER2)=DGAUDERR(DGAUDERR),DGAUDER2=DGAUDER2+1
  1.  D FILE^DID(46.3,,"ENTRIES","DGAUDDATA")
  1.  S DGAUDNUM=$G(DGAUDDATA("ENTRIES"))
  1.  S DGAUDER2(DGAUDER2)="",DGAUDER2=DGAUDER2+1
  1.  S DGAUDER2(DGAUDER2)="The ^DGAUDIT global contains "_DGAUDNUM_" entr"_$S(DGAUDNUM=1:"y",1:"ies")_".",DGAUDER2=DGAUDER2+1
  1.  S DGAUDER2(DGAUDER2)="The maximum number of entries in the queue is "_$$GET^XPAR("ALL","DG VAS MAX QUEUE ENTRIES")_".",DGAUDER2=DGAUDER2+1
  1.  S DGAUDER2(DGAUDER2)="",DGAUDER2=DGAUDER2+1
  1.  D SNDMSG^DGAUDIT(.DGAUDER2,,$G(DGALTSUB)) K DGAUDERR,DGAUDER2
  1.  Q