BJPN20AU ;GDIT/HS/BEE-Prenatal Care Module 2.0 Post Install (Cont.) ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
;
Q
;
AUD(AUD,FILE,FLIEN) ;EP - File audit file entries
;
NEW IBY,IONDT,AFLD
;
;Pull person who modified
S IBY=$P($G(AUD),U,4)
I IBY="",FILE="90680.01" D
. S IBY=$P($G(AUD(1.04,"I")),U,2)
. S:IBY="" IBY=$P($G(AUD(1.03,"I")),U,2)
. S:IBY="" IBY=DUZ
I IBY="",FILE="9000011" D
. S IBY=$P($G(AUD(1.03,"I")),U,2)
. S:IBY="" IBY=DUZ
;
;Pull date/time modified
S IONDT=$P($G(AUD),U,3)
I IONDT="",FILE="90680.01" D
. S IONDT=$P($G(AUD(1.03,"I")),U,2)
. S:IONDT="" IONDT=$P($G(AUD(1.01,"I")),U,2)
. S:IONDT="" IONDT=$$HTFM^DILIBF($J)
I IONDT="",FILE="9000011" D
. S IONDT=$P($G(AUD(.03,"I")),U,2)
. S:IONDT="" IONDT=$$HTFM^DILIBF($J)
;
;Loop through each entry to be audited
S AFLD="" F S AFLD=$O(AUD(AFLD)) Q:AFLD="" D
. ;
. NEW AIEN,DTYPE,IOVALUE,INVALUE,XOVALUE,XNVALUE,DTYPE,NEW
. ;
. ;Pull the values
. S IOVALUE=$P($G(AUD(AFLD,"I")),U)
. S INVALUE=$P($G(AUD(AFLD,"I")),U,2)
. S XOVALUE=$P($G(AUD(AFLD,"X")),U)
. S XNVALUE=$P($G(AUD(AFLD,"X")),U,2)
. S DTYPE=$P($G(^DD(FILE,AFLD,0)),U,2) Q:DTYPE=""
. ;
. ;Create the base entry
. S AIEN=$$ADD(FILE,FLIEN,IONDT,IBY) Q:'+AIEN
. ;
. ;Determine if a new entry
. S NEW="" I FILE="9000011",AFLD=".01" S NEW="A"
. I FILE="90680.01",AFLD=".12" S NEW="A"
. ;
. ;Save old value if populated
. I IOVALUE]"" D
.. S ^DIA(FILE,AIEN,2)=XOVALUE
.. S ^DIA(FILE,AIEN,2.1)=IOVALUE_U_DTYPE
. ;
. ;Save new value
. S ^DIA(FILE,AIEN,3)=XNVALUE
. S ^DIA(FILE,AIEN,3.1)=INVALUE_U_DTYPE
. ;
. ;Update top entry
. S $P(^DIA(FILE,AIEN,0),U,2,4)=IONDT_U_AFLD_U_IBY_U_NEW
;
Q
;
ADD(%F,FLIEN,ONDT,BY) ;EP - Credit audit entry
NEW Y
S Y=$O(^DIA(%F,"A"),-1) I 'Y S ^DIA(%F,0)=$P(^DIC(%F,0),U)_" AUDIT^1.1I"
F Y=Y+1:1 I '$D(^DIA(%F,Y)) D LOCK^DILF("^DIA(%F,Y)") I Q:'$D(^DIA(%F,Y)) L -^DIA(%F,Y)
S ^DIA(%F,Y,0)=FLIEN L -^DIA(%F,Y)
S $P(^DIA(%F,0),U,3,4)=Y_U_($P(^DIA(%F,0),U,4)+1)
;
S ^DIA(%F,"C",ONDT,Y)="",^DIA(%F,"D",BY,Y)="",^DIA(%F,"B",FLIEN,Y)=""
Q Y
;
OFF(DIFILE,DIFIELD) ;Temporarily turn off auditing for field for file
;
NEW DIOLD,D,DA,DIMODE,DIE,DR
;
;Handle subfields
I DIFIELD["," D I (DIFILE="")!(DIFIELD="") Q
. S DIFILE=+$P(^DD(DIFILE,$P(DIFIELD,","),0),U,2),DIFIELD=$P(DIFIELD,",",2)
;
S DIOLD=$G(^DD(DIFILE,DIFIELD,"AUDIT")) I DIOLD="" Q DIOLD ;It's already off
;
;Skip computed fields - not used for BJPN conversion
S D=$P($G(^DD(DIFILE,DIFIELD,"AUDIT",0)),U,2) Q:D["C" ""
;
;Skip word processing fields - not used for BJPN conversion
I D Q:$P($G(^DD(+D,.01,0)),U,2)["W" ""
;
;Skip number field
I DIFIELD=".001" Q ""
;
;Turn off auditing for field
S DIMODE="@"
S DR="1.1////"_DIMODE,DIE="^DD("_DIFILE_",",DA(1)=DIFILE,DA=DIFIELD
D ^DIE
;
Q DIOLD
;
ON(DIFILE,DIFIELD,DIMODE) ;Turn auditing for field for back on
;
NEW DIOLD,D,DA,DIE,DR
;
;Handle subfields
I DIFIELD["," D I (DIFILE="")!(DIFIELD="") Q
. S DIFILE=+$P(^DD(DIFILE,$P(DIFIELD,","),0),U,2),DIFIELD=$P(DIFIELD,",",2)
;
S DIOLD=$G(^DD(DIFILE,DIFIELD,"AUDIT")) I DIOLD=$G(DIMODE) Q ;It's already on
;
;Skip computed fields - not used for BJPN conversion
S D=$P($G(^DD(DIFILE,DIFIELD,"AUDIT",0)),U,2) Q:D["C"
;
;Skip word processing fields - not used for BJPN conversion
I D Q:$P($G(^DD(+D,.01,0)),U,2)["W" ""
;
;Skip number field
I DIFIELD=".001" Q
;
;Turn on auditing for field
S:$G(DIMODE)="" DIMODE="y"
S DR="1.1////"_DIMODE,DIE="^DD("_DIFILE_",",DA(1)=DIFILE,DA=DIFIELD
D ^DIE
Q
BJPN20AU ;GDIT/HS/BEE-Prenatal Care Module 2.0 Post Install (Cont.) ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
+2 ;
+3 QUIT
+4 ;
AUD(AUD,FILE,FLIEN) ;EP - File audit file entries
+1 ;
+2 NEW IBY,IONDT,AFLD
+3 ;
+4 ;Pull person who modified
+5 SET IBY=$PIECE($GET(AUD),U,4)
+6 IF IBY=""
IF FILE="90680.01"
Begin DoDot:1
+7 SET IBY=$PIECE($GET(AUD(1.04,"I")),U,2)
+8 IF IBY=""
SET IBY=$PIECE($GET(AUD(1.03,"I")),U,2)
+9 IF IBY=""
SET IBY=DUZ
End DoDot:1
+10 IF IBY=""
IF FILE="9000011"
Begin DoDot:1
+11 SET IBY=$PIECE($GET(AUD(1.03,"I")),U,2)
+12 IF IBY=""
SET IBY=DUZ
End DoDot:1
+13 ;
+14 ;Pull date/time modified
+15 SET IONDT=$PIECE($GET(AUD),U,3)
+16 IF IONDT=""
IF FILE="90680.01"
Begin DoDot:1
+17 SET IONDT=$PIECE($GET(AUD(1.03,"I")),U,2)
+18 IF IONDT=""
SET IONDT=$PIECE($GET(AUD(1.01,"I")),U,2)
+19 IF IONDT=""
SET IONDT=$$HTFM^DILIBF($JOB)
End DoDot:1
+20 IF IONDT=""
IF FILE="9000011"
Begin DoDot:1
+21 SET IONDT=$PIECE($GET(AUD(.03,"I")),U,2)
+22 IF IONDT=""
SET IONDT=$$HTFM^DILIBF($JOB)
End DoDot:1
+23 ;
+24 ;Loop through each entry to be audited
+25 SET AFLD=""
FOR
SET AFLD=$ORDER(AUD(AFLD))
IF AFLD=""
QUIT
Begin DoDot:1
+26 ;
+27 NEW AIEN,DTYPE,IOVALUE,INVALUE,XOVALUE,XNVALUE,DTYPE,NEW
+28 ;
+29 ;Pull the values
+30 SET IOVALUE=$PIECE($GET(AUD(AFLD,"I")),U)
+31 SET INVALUE=$PIECE($GET(AUD(AFLD,"I")),U,2)
+32 SET XOVALUE=$PIECE($GET(AUD(AFLD,"X")),U)
+33 SET XNVALUE=$PIECE($GET(AUD(AFLD,"X")),U,2)
+34 SET DTYPE=$PIECE($GET(^DD(FILE,AFLD,0)),U,2)
IF DTYPE=""
QUIT
+35 ;
+36 ;Create the base entry
+37 SET AIEN=$$ADD(FILE,FLIEN,IONDT,IBY)
IF '+AIEN
QUIT
+38 ;
+39 ;Determine if a new entry
+40 SET NEW=""
IF FILE="9000011"
IF AFLD=".01"
SET NEW="A"
+41 IF FILE="90680.01"
IF AFLD=".12"
SET NEW="A"
+42 ;
+43 ;Save old value if populated
+44 IF IOVALUE]""
Begin DoDot:2
+45 SET ^DIA(FILE,AIEN,2)=XOVALUE
+46 SET ^DIA(FILE,AIEN,2.1)=IOVALUE_U_DTYPE
End DoDot:2
+47 ;
+48 ;Save new value
+49 SET ^DIA(FILE,AIEN,3)=XNVALUE
+50 SET ^DIA(FILE,AIEN,3.1)=INVALUE_U_DTYPE
+51 ;
+52 ;Update top entry
+53 SET $PIECE(^DIA(FILE,AIEN,0),U,2,4)=IONDT_U_AFLD_U_IBY_U_NEW
End DoDot:1
+54 ;
+55 QUIT
+56 ;
ADD(%F,FLIEN,ONDT,BY) ;EP - Credit audit entry
+1 NEW Y
+2 SET Y=$ORDER(^DIA(%F,"A"),-1)
IF 'Y
SET ^DIA(%F,0)=$PIECE(^DIC(%F,0),U)_" AUDIT^1.1I"
+3 FOR Y=Y+1:1
IF '$DATA(^DIA(%F,Y))
DO LOCK^DILF("^DIA(%F,Y)")
IF $TEST
IF '$DATA(^DIA(%F,Y))
QUIT
LOCK -^DIA(%F,Y)
+4 SET ^DIA(%F,Y,0)=FLIEN
LOCK -^DIA(%F,Y)
+5 SET $PIECE(^DIA(%F,0),U,3,4)=Y_U_($PIECE(^DIA(%F,0),U,4)+1)
+6 ;
+7 SET ^DIA(%F,"C",ONDT,Y)=""
SET ^DIA(%F,"D",BY,Y)=""
SET ^DIA(%F,"B",FLIEN,Y)=""
+8 QUIT Y
+9 ;
OFF(DIFILE,DIFIELD) ;Temporarily turn off auditing for field for file
+1 ;
+2 NEW DIOLD,D,DA,DIMODE,DIE,DR
+3 ;
+4 ;Handle subfields
+5 IF DIFIELD[","
Begin DoDot:1
+6 SET DIFILE=+$PIECE(^DD(DIFILE,$PIECE(DIFIELD,","),0),U,2)
SET DIFIELD=$PIECE(DIFIELD,",",2)
End DoDot:1
IF (DIFILE="")!(DIFIELD="")
QUIT
+7 ;
+8 ;It's already off
SET DIOLD=$GET(^DD(DIFILE,DIFIELD,"AUDIT"))
IF DIOLD=""
QUIT DIOLD
+9 ;
+10 ;Skip computed fields - not used for BJPN conversion
+11 SET D=$PIECE($GET(^DD(DIFILE,DIFIELD,"AUDIT",0)),U,2)
IF D["C"
QUIT ""
+12 ;
+13 ;Skip word processing fields - not used for BJPN conversion
+14 IF D
IF $PIECE($GET(^DD(+D,.01,0)),U,2)["W"
QUIT ""
+15 ;
+16 ;Skip number field
+17 IF DIFIELD=".001"
QUIT ""
+18 ;
+19 ;Turn off auditing for field
+20 SET DIMODE="@"
+21 SET DR="1.1////"_DIMODE
SET DIE="^DD("_DIFILE_","
SET DA(1)=DIFILE
SET DA=DIFIELD
+22 DO ^DIE
+23 ;
+24 QUIT DIOLD
+25 ;
ON(DIFILE,DIFIELD,DIMODE) ;Turn auditing for field for back on
+1 ;
+2 NEW DIOLD,D,DA,DIE,DR
+3 ;
+4 ;Handle subfields
+5 IF DIFIELD[","
Begin DoDot:1
+6 SET DIFILE=+$PIECE(^DD(DIFILE,$PIECE(DIFIELD,","),0),U,2)
SET DIFIELD=$PIECE(DIFIELD,",",2)
End DoDot:1
IF (DIFILE="")!(DIFIELD="")
QUIT
+7 ;
+8 ;It's already on
SET DIOLD=$GET(^DD(DIFILE,DIFIELD,"AUDIT"))
IF DIOLD=$GET(DIMODE)
QUIT
+9 ;
+10 ;Skip computed fields - not used for BJPN conversion
+11 SET D=$PIECE($GET(^DD(DIFILE,DIFIELD,"AUDIT",0)),U,2)
IF D["C"
QUIT
+12 ;
+13 ;Skip word processing fields - not used for BJPN conversion
+14 IF D
IF $PIECE($GET(^DD(+D,.01,0)),U,2)["W"
QUIT ""
+15 ;
+16 ;Skip number field
+17 IF DIFIELD=".001"
QUIT
+18 ;
+19 ;Turn on auditing for field
+20 IF $GET(DIMODE)=""
SET DIMODE="y"
+21 SET DR="1.1////"_DIMODE
SET DIE="^DD("_DIFILE_","
SET DA(1)=DIFILE
SET DA=DIFIELD
+22 DO ^DIE
+23 QUIT
