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

DGENUPA1.m

Go to the documentation of this file.
  1. DGENUPA1 ;ALB/CJM - UPLOAD AUDIT ; 04-APR-94
  1. ;;5.3;REGISTRATION;**147,222,232**;Aug 13,1993
  1. ;
  1. AUDIT(ERROR,MSGID,OLDPAT,NEWPAT,OLDELG,NEWELG,OLDCDIS,NEWCDIS,NEWSEC,OLDSEC) ;
  1. ;Description: creates an audit trail for an upload.
  1. ;
  1. ;Input:
  1. ;Output:
  1. ; Function Value: 1 on sucess, 0 on failure
  1. ; ERROR - error message (optional, pass by reference)
  1. N AUDIT
  1. D CREATE^DGENUPA(OLDPAT("DFN"),,MSGID,.AUDIT)
  1. D PAT
  1. D ELIG
  1. D ELGCODES
  1. D RDISB
  1. D CDIS
  1. D SEC
  1. Q +$$STORE^DGENUPA(.AUDIT,.ERROR)
  1. ;
  1. ELIG ;
  1. ;Description: Changes for Eligibility object (other than multiples)
  1. N FIELD,LINE,IEN,HDR
  1. S HDR=0
  1. I OLDELG("ELIG","CODE")'=NEWELG("ELIG","CODE") D
  1. .;
  1. .S LINE=$$LJ^XLFSTR("PRIMRY ELIG: ",15)_$$LJ^XLFSTR($$EXT^DGENELA3("CODE",OLDELG("ELIG","CODE")),33)_" "_$$EXT^DGENELA3("CODE",NEWELG("ELIG","CODE"))
  1. .I 'HDR D ELGHDR
  1. .D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. ;
  1. S FIELD=""
  1. F S FIELD=$O(OLDELG(FIELD)) Q:(FIELD="") D
  1. .Q:((FIELD="ELIG")!(FIELD="RATEDIS")!(FIELD="MTSTA")!(FIELD="DFN")) ;MT Status not uploaded
  1. .I OLDELG(FIELD)'=NEWELG(FIELD) D
  1. ..;
  1. ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENELA3(FIELD,OLDELG(FIELD)),33)_" "_$$EXT^DGENELA3(FIELD,NEWELG(FIELD))
  1. ..I 'HDR D ELGHDR
  1. ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. Q
  1. ;
  1. ELGHDR ;
  1. ;Description: Header for changes in ELIGIBILITY object
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT," Patient Eligibility")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
  1. D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
  1. S HDR=1
  1. Q
  1. ;
  1. ELGCODES ;
  1. ;Description: Changes in Patient Eligibilities
  1. ;
  1. N FIELD,LINE,IEN,HDR
  1. S HDR=0
  1. S IEN=0
  1. F S IEN=$O(NEWELG("ELIG","CODE",IEN)) Q:'IEN I '$G(OLDELG("ELIG","CODE",IEN)) D
  1. .D:'HDR AELGHDR
  1. .D ADDCHNG^DGENUPA(.AUDIT," "_$$EXT^DGENELA3("CODE",IEN))
  1. ;
  1. S HDR=0
  1. S IEN=0
  1. F S IEN=$O(OLDELG("ELIG","CODE",IEN)) Q:'IEN I '$G(NEWELG("ELIG","CODE",IEN)) D
  1. .;
  1. .;the new primary eligibility code will be placed in the eligibilities multiple via the x-ref
  1. .Q:(OLDELG("ELIG","CODE",IEN)=NEWELG("ELIG","CODE"))
  1. .;
  1. .D:'HDR DELGHDR
  1. .D ADDCHNG^DGENUPA(.AUDIT," "_$$EXT^DGENELA3("CODE",IEN))
  1. ;
  1. Q
  1. ;
  1. AELGHDR ;
  1. ;Description: Header for eligibility codes added
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Patient Eligibilities Added:")
  1. S HDR=1
  1. Q
  1. ;
  1. DELGHDR ;
  1. ;Description: Header for eligibility codes deleted
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Patient Eligibilities Deleted:")
  1. S HDR=1
  1. Q
  1. ;
  1. RDISB ;
  1. ;Description: Changes in Rated Disabilities
  1. ;
  1. N COUNT,NEWDIBS,OLDDIBS,IEN,PER,SC,HDR
  1. ;set up the rated disabilities in a more useful format to detect changes
  1. S COUNT=0
  1. F S COUNT=$O(NEWELG("RATEDIS",COUNT)) Q:'COUNT S NEWDIBS(+NEWELG("RATEDIS",COUNT,"RD"),+NEWELG("RATEDIS",COUNT,"PER"),$J(NEWELG("RATEDIS",COUNT,"RDSC"),1))=""
  1. S COUNT=0
  1. F S COUNT=$O(OLDELG("RATEDIS",COUNT)) Q:'COUNT S OLDDIBS(+OLDELG("RATEDIS",COUNT,"RD"),+OLDELG("RATEDIS",COUNT,"PER"),$J(OLDELG("RATEDIS",COUNT,"RDSC"),1))=""
  1. ;
  1. ;find disabilty taht have been added
  1. S HDR=0
  1. S IEN=0
  1. F S IEN=$O(NEWDIBS(IEN)) Q:'IEN D
  1. .S PER=""
  1. .F S PER=$O(NEWDIBS(IEN,PER)) Q:(PER="") D
  1. ..S SC=""
  1. ..F S SC=$O(NEWDIBS(IEN,PER,SC)) Q:(SC="") D
  1. ...I '$D(OLDDIBS(IEN,PER,SC)) D
  1. ....D:'HDR ARDISHDR
  1. ....D ADDCHNG^DGENUPA(.AUDIT," "_$$LJ^XLFSTR($$EXT^DGENELA3("RD",IEN),45)_" Percent: "_PER_" SC: "_$$EXT^DGENELA3("RDSC",SC))
  1. ;
  1. ;find disabilities that have been deleted
  1. S HDR=0
  1. S IEN=0
  1. F S IEN=$O(OLDDIBS(IEN)) Q:'IEN D
  1. .S PER=""
  1. .F S PER=$O(OLDDIBS(IEN,PER)) Q:(PER="") D
  1. ..S SC=""
  1. ..F S SC=$O(OLDDIBS(IEN,PER,SC)) Q:(SC="") D
  1. ...I '$D(NEWDIBS(IEN,PER,SC)) D
  1. ....D:'HDR DRDISHDR
  1. ....D ADDCHNG^DGENUPA(.AUDIT," "_$$LJ^XLFSTR($$EXT^DGENELA3("RD",IEN),45)_" Percent: "_PER_" SC: "_$$EXT^DGENELA3("RDSC",SC))
  1. Q
  1. ;
  1. DRDISHDR ;
  1. ;Description: Header for deleted disabilities
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Rated Disabilities Deleted:")
  1. S HDR=1
  1. Q
  1. ;
  1. ARDISHDR ;
  1. ;Description: Header for added disabilities
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Rated Disabilities Added:")
  1. S HDR=1
  1. Q
  1. ;
  1. PAT ;
  1. ;Description: Changes in PATIENT object
  1. ;
  1. N FIELD,LINE,IEN,HDR
  1. S HDR=0
  1. S FIELD=""
  1. F S FIELD=$O(OLDPAT(FIELD)) Q:(FIELD="") D
  1. .Q:((FIELD="DFN")) ;
  1. .I OLDPAT(FIELD)'=NEWPAT(FIELD) D
  1. ..;
  1. ..I 'HDR D PATHDR
  1. ..I FIELD="DEATH" S LINE="** ALERT ONLY: Changes to Date of Death are NOT automatically updated **" D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENPTA(FIELD,OLDPAT(FIELD)),33)_" "_$$EXT^DGENPTA(FIELD,NEWPAT(FIELD))
  1. ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. Q
  1. ;
  1. PATHDR ;
  1. ;Descripition: Header for changes in PATIENT object
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," Patient Demographics")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
  1. D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
  1. S HDR=1
  1. Q
  1. ;
  1. CDIS ;
  1. ;Description: Changes in CATASTROPHIC DISABILTY object
  1. ;
  1. N SUBFIELD,FIELD,LINE,IEN,HDR
  1. S HDR=0
  1. S FIELD=""
  1. F S FIELD=$O(OLDCDIS(FIELD)) Q:(FIELD="") D
  1. .I $D(OLDCDIS(FIELD))'=1 Q
  1. .I OLDCDIS(FIELD)'=NEWCDIS(FIELD) D
  1. ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENCDU(FIELD,OLDCDIS(FIELD)),33)_" "_$$EXT^DGENCDU(FIELD,NEWCDIS(FIELD))
  1. ..I 'HDR D CDISHDR
  1. ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. F FIELD="SCORE","PROC","PERM","EXT","DIAG","COND" D
  1. .F SUBFIELD=1:1 Q:('$D(OLDCDIS(FIELD,SUBFIELD)))&('$D(NEWCDIS(FIELD,SUBFIELD))) D
  1. ..I $G(OLDCDIS(FIELD,SUBFIELD))'=$G(NEWCDIS(FIELD,SUBFIELD)) D
  1. ...S LINE=$$LJ^XLFSTR(FIELD_": ",15)
  1. ...S LINE=LINE_$$LJ^XLFSTR($S($G(OLDCDIS(FIELD,SUBFIELD))'="":$$EXT^DGENCDU(FIELD,OLDCDIS(FIELD,SUBFIELD)),1:""),33)
  1. ...S LINE=LINE_" "_$S($G(NEWCDIS(FIELD,SUBFIELD))'="":$$EXT^DGENCDU(FIELD,NEWCDIS(FIELD,SUBFIELD)),1:"")
  1. ...I 'HDR D CDISHDR
  1. ...D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. Q
  1. ;
  1. CDISHDR ;
  1. ;Descripition: Header for changes in CATASTROPHIC DISABILTY object
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT," Catastrophic Disability")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
  1. D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
  1. S HDR=1
  1. Q
  1. ;
  1. SEC ;
  1. ; Description: Changes in PATIENT SECURITY object
  1. ;
  1. N FIELD,LINE,IEN,HDR
  1. S HDR=0
  1. S FIELD=""
  1. F S FIELD=$O(OLDSEC(FIELD)) Q:(FIELD="") D
  1. .;
  1. .Q:((FIELD="DFN")) ; do not need to audit this field
  1. .I OLDSEC(FIELD)'=NEWSEC(FIELD) D
  1. ..;
  1. ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENSEC(FIELD,OLDSEC(FIELD)),33)_" "_$$EXT^DGENSEC(FIELD,NEWSEC(FIELD))
  1. ..I 'HDR D SECHDR
  1. ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
  1. ;
  1. Q
  1. ;
  1. SECHDR ;
  1. ; Description: Header for changes in PATIENT SECURITY object
  1. ;
  1. D ADDCHNG^DGENUPA(.AUDIT," ")
  1. D ADDCHNG^DGENUPA(.AUDIT," Patient Security")
  1. D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
  1. D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
  1. S HDR=1
  1. Q