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 ---[H[J[2J[HPX1P94 1002 printed Dec 13, 2024@02:25: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 ;
