BGOIN002.m

BGOIN002 ; IHS/MSC/DKM - Patient Education Bad Pointer Fix;26-May-2006 18:22;DKM

 ;;1.1;BGO;**2**;JUN 02, 2005

 ; Environment check

 ; Don't install BGOVPED routine if EHR 1.1 installed

EC N IEN

 S IEN=""

 F  S IEN=$O(^XPD(9.7,"B","EHR 1.1",IEN),-1) Q:'IEN  Q:$$GET1^DIQ(9.7,IEN,.02,"I")=3

 I IEN,$$RTNUP^XPDUTL("BGOVPED",2)

 Q

 ; Preinit

PRE Q

 ; Postinit

 ; Fixes bad ICD9 pointers in V PATIENT ED file

POST N IEN,N0,ICD1,ICD2,PTR,CNT

 D BMES^XPDUTL("Scanning V PATIENT ED file for bad ICD9 pointers...")

 S (CNT,IEN)=0

 F  S IEN=$O(^AUPNVPED(IEN)) Q:'IEN  S N0=$G(^(IEN,0)) D:$L(N0)

 .S ICD1=$P(N0,U,4)

 .Q:'ICD1

 .S ICD2=$P($G(^AUTTEDT(+N0,0)),U,4)

 .Q:'ICD2

 .Q:ICD1=ICD2

 .S PTR=+$$ICD(ICD1)

 .Q:'PTR

 .Q:PTR'=ICD2

 .S $P(^AUPNVPED(IEN,0),U,4)=PTR,CNT=CNT+1

 .D BMES^XPDUTL("  IEN #"_IEN_" modified: "_$$ICD(ICD1)_"-->"_$$ICD(ICD2))

 D BMES^XPDUTL("Total entries modified: "_CNT)

 Q

ICD(X) Q $P($G(^ICD9(+X,0)),U)

BGOIN002  ; IHS/MSC/DKM - Patient Education Bad Pointer Fix;26-May-2006 18:22;DKM

 +1       ;;1.1;BGO;**2**;JUN 02, 2005

 +2       ; Environment check

 +3       ; Don't install BGOVPED routine if EHR 1.1 installed

EC         NEW IEN

 +1        SET IEN=""

 +2        FOR 

               SET IEN=$ORDER(^XPD(9.7,"B","EHR 1.1",IEN),-1)

               IF 'IEN

                   QUIT 

               IF $$GET1^DIQ(9.7,IEN,.02,"I")=3

                   QUIT 

 +3        IF IEN

               IF $$RTNUP^XPDUTL("BGOVPED",2)

 +4        QUIT 

 +5       ; Preinit

PRE        QUIT 

 +1       ; Postinit

 +2       ; Fixes bad ICD9 pointers in V PATIENT ED file

POST       NEW IEN,N0,ICD1,ICD2,PTR,CNT

 +1        DO BMES^XPDUTL("Scanning V PATIENT ED file for bad ICD9 pointers...")

 +2        SET (CNT,IEN)=0

 +3        FOR 

               SET IEN=$ORDER(^AUPNVPED(IEN))

               IF 'IEN

                   QUIT 

               SET N0=$GET(^(IEN,0))

               IF $LENGTH(N0)

                   Begin DoDot:1

 +4                    SET ICD1=$PIECE(N0,U,4)

 +5                    IF 'ICD1

                           QUIT 

 +6                    SET ICD2=$PIECE($GET(^AUTTEDT(+N0,0)),U,4)

 +7                    IF 'ICD2

                           QUIT 

 +8                    IF ICD1=ICD2

                           QUIT 

 +9                    SET PTR=+$$ICD(ICD1)

 +10                   IF 'PTR

                           QUIT 

 +11                   IF PTR'=ICD2

                           QUIT 

 +12                   SET $PIECE(^AUPNVPED(IEN,0),U,4)=PTR

                       SET CNT=CNT+1

 +13                   DO BMES^XPDUTL("  IEN #"_IEN_" modified: "_$$ICD(ICD1)_"-->"_$$ICD(ICD2))

                   End DoDot:1

 +14       DO BMES^XPDUTL("Total entries modified: "_CNT)

 +15       QUIT 

ICD(X)     QUIT $PIECE($GET(^ICD9(+X,0)),U)