PX1P94.m

PX1P94 ;PB - Cleanup Unresolved entries in Problem (#9000011) file ; 07/13/00

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**94**;Aug 12, 1996

 ;

 ;

START ; Entry point

 N DA,DR,DIE

 N IEN,ICD9CODE,LEXCODE,LEXS

 S (ICD9CODE,IEN,LEXCODE)=0

 ; Search for Unresolved entries

 F  S IEN=$O(^AUPNPROB("C",1,IEN)) Q:IEN=""  D

 .S ICD9CODE=$$GETICD(IEN) Q:ICD9CODE=-1  ; Get ICD9 Code

 .S LEXCODE=$$GETLEXCD(ICD9CODE) ; Get Lexicon Code

 .I LEXCODE=-1!(LEXCODE=1) Q

 .; Edit File entry to include Lexicon code for problem

 .S DR="1.01////^S X=LEXCODE",DIE="9000011",DA=IEN

 .D ^DIE

 Q

 ;

GETLEXCD(ICD9CODE) ; Retrieve Lexicon Code for passed ICD9 code

 NEW LEXS,LEXCD

 S LEXCD=-1

 D EN^LEXCODE(ICD9CODE)

 I $G(LEXS("ICD",0))>0 S LEXCD=$P($G(LEXS("ICD",1)),"^",1)

 Q LEXCD

 ;

GETICD(IEN) ; Retrieve ICD9 code

 NEW ICDPTR,ICD9C

 ; PTR to ICD9 file

 S ICDPTR=$P($G(^AUPNPROB(IEN,0)),U,1) Q:ICDPTR="" -1

 I '$D(^ICD9(ICDPTR)) Q -1

 S ICD9C=$P($G(^ICD9(ICDPTR,0)),U,1) ; ICD9 Code

 Q ICD9C

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PX1P94   1002     printed  Apr 09, 2024@21:27:39                                                                                                                                                                                                      Page 2

PX1P94    ;PB - Cleanup Unresolved entries in Problem (#9000011) file ; 07/13/00

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**94**;Aug 12, 1996

 +2       ;

 +3       ;

START     ; Entry point

 +1        NEW DA,DR,DIE

 +2        NEW IEN,ICD9CODE,LEXCODE,LEXS

 +3        SET (ICD9CODE,IEN,LEXCODE)=0

 +4       ; Search for Unresolved entries

 +5        FOR 

               SET IEN=$ORDER(^AUPNPROB("C",1,IEN))

               if IEN=""

                   QUIT 

               Begin DoDot:1

 +6       ; Get ICD9 Code

                   SET ICD9CODE=$$GETICD(IEN)

                   if ICD9CODE=-1

                       QUIT 

 +7       ; Get Lexicon Code

                   SET LEXCODE=$$GETLEXCD(ICD9CODE)

 +8                IF LEXCODE=-1!(LEXCODE=1)

                       QUIT 

 +9       ; Edit File entry to include Lexicon code for problem

 +10               SET DR="1.01////^S X=LEXCODE"

                   SET DIE="9000011"

                   SET DA=IEN

 +11               DO ^DIE

               End DoDot:1

 +12       QUIT 

 +13      ;

GETLEXCD(ICD9CODE) ; Retrieve Lexicon Code for passed ICD9 code

 +1        NEW LEXS,LEXCD

 +2        SET LEXCD=-1

 +3        DO EN^LEXCODE(ICD9CODE)

 +4        IF $GET(LEXS("ICD",0))>0

               SET LEXCD=$PIECE($GET(LEXS("ICD",1)),"^",1)

 +5        QUIT LEXCD

 +6       ;

GETICD(IEN) ; Retrieve ICD9 code

 +1        NEW ICDPTR,ICD9C

 +2       ; PTR to ICD9 file

 +3        SET ICDPTR=$PIECE($GET(^AUPNPROB(IEN,0)),U,1)

           if ICDPTR=""

               QUIT -1

 +4        IF '$DATA(^ICD9(ICDPTR))

               QUIT -1

 +5       ; ICD9 Code

           SET ICD9C=$PIECE($GET(^ICD9(ICDPTR,0)),U,1)

 +6        QUIT ICD9C

 +7       ;