BJPN20AU.m

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