- APCD3M ; IHS/CMI/LAB - PCC TO 3M CODER INTERFACE ;
- ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
- ;;2.0
- ;
- ; This routine processes inbound HL7 messages from the 3M Coder
- ; and generates outbound HL7 messages to send to the 3M Coder.
- ;
- ; The entry point IN is called by the HL7 package to process
- ; an inbound message from the 3M Coder. An entry is generated
- ; in file 9001001.9 for the specified visit which contains the
- ; ICD codes and provider narratives required to generate the
- ; appropriate V POV and V PROCEDURE entries for this visit.
- ;
- ; The entry point OUT is called to generate an HL7 message
- ; containing patient demographic and medical data required
- ; by the 3M Coder to assign ICD codes to V POV entries. The
- ; visit IEN is passed in APCDVSIT.
- ;
- ;cmi/anch/maw 10/11/2005 modified due to change in 3m structure
- ;cmi/anch/maw 12/2/2005 maw added clean of destination queue before sending
- ;cmi/anch/maw 3/6/2007 maw modified DISPCPT to screen off description
- ;cmi/anch/maw 3/6/2007 maw modified DISPICD to get if a V code
- ;cmi/tucson/lab 11/12/2007 code set versioning
- ;
- Q ;do not enter at top of routine
- ;
- IN ; EP - PROCESS HL7 MESSAGE FROM 3M CODER
- ;maw this is where the inbound stuff starts
- NEW APCD3COD,APCD3IEN,APCD3NAR,APCDQ,I,J,X,Y
- D INMAIN
- D EOJ
- Q
- ;
- INMAIN ; INBOUND MAINLINE LOGIC
- D INSTALL ; generate 9001001.9 entry
- Q
- ;
- INSTALL ; GENERATE 9001001.9 ENTRY
- F J=1:1 S X=$G(APCDHL7M(J)) Q:X="" D Q:$G(APCD3MER)
- . S Y=$P(X,"|") ; get segment
- . I Y="PV1" D IPV1 Q ; pv1 segment
- . I Y="DG1" D IDG1 Q ; dg1 segment
- . I Y="PR1" D IPR1 Q ; pr1 segment
- . I Y="DRG" D IDRG Q ; drg segment
- . Q
- Q
- ;
- IPV1 ; PV1 SEGMENT
- S X=$P(X,"|",20)
- I 'X S APCD3MER="200^No Visit IEN in Message" D ERR Q
- S DIC="^APCD3MV(",DIC(0)="L",DLAYGO=9001001.9,DIC("DR")=".02////"_UIF
- S DINUM=X
- D FILE
- I Y<0 S APCD3MER="100^Error adding message to 3M file" D ERR Q
- S APCD3IEN=+Y
- Q
- ;
- IDG1 ; DG1 SEGMENT
- S APCD3COD=$P($P(X,"|",4),U) ; get ICD9 code
- S APCD3TXT=$P($P(X,"|",4),U,2) ;icd desc
- S APCD3DTP=$P(X,"|",7) ;diagnosis type
- Q:$G(APCD3DTP)="A" ;don't file admit dx
- ;I $E(APCD3COD,1,1)="E" S APCDECOD=APCD3COD D Q
- ;. I APCDECOD'["." S APCDECOD=$E(APCDECOD,1,4)_"."_$E(APCDECOD,5,999)
- ;. D UPDCODE Q
- I $E(APCD3COD,1,1)="E" D
- . I APCD3COD'["." S APCD3COD=$E(APCD3COD,1,4)_"."_$E(APCD3COD,5,999)
- I $E(APCD3COD,1,1)'="E" D
- . I APCD3COD'["." S APCD3COD=$E(APCD3COD,1,3)_"."_$E(APCD3COD,4,999)
- I APCD3COD="" S APCD3MER="204^POV ICD9 code missing" Q
- S X=APCD3COD,DA(1)=APCD3IEN,DIC="^APCD3MV("_DA(1)_",11,",DIC(0)="L",DIC("P")=$P(^DD(9001001.9,1101,0),U,2)
- S DIC("DR")=".02///"_$G(APCD3TXT)
- D FILE
- I Y<0 S APCD3MER="210^Error adding POV to 3M file" D ERR Q
- S APCDDG1=+Y
- Q
- ;
- IPR1 ; PR1 SEGMENT
- S APCD3COD=$P($P(X,"|",4),U) ; get ICD9 code
- S APCD3TXT=$P($P(X,"|",4),U,2) ; cpt description
- S APCDCTP=$P($P(X,"|",4),U,3) ; get type of coding system
- S APCD3MOD=$P(X,"|",17) ; get modifier
- I APCD3COD="" S APCD3MER="208^PROC ICD9 code missing" Q
- I $G(APCDCTP)="CP" D ICPT Q ;goto cpt filer then quit
- I $G(APCDCTP)="H" D ICPT Q ;hcps codes
- I $E(APCD3COD,1)'?.N D ICPT Q ;non icd codes
- ;I $L(APCD3COD)>4 D ICPT Q ;cpt codes 10/25/2005 maw commented out
- I APCD3COD'["." S APCD3COD=$E(APCD3COD,1,2)_"."_$E(APCD3COD,3,999)
- S X=APCD3COD,DA(1)=APCD3IEN,DIC="^APCD3MV("_DA(1)_",12,",DIC(0)="L",DIC("P")=$P(^DD(9001001.9,1201,0),U,2)
- S DIC("DR")=".02///"_$G(APCD3TXT)
- D FILE
- I Y<0 S APCD3MER="211^Error adding Procedure to 3M file" D ERR Q
- S APCDPR1=+Y
- Q
- ;
- IDRG ;-- get the drg
- S APCD3DRG=$P(X,"|",2)
- I APCD3DRG'="" S APCD3DRG="DRG"_+APCD3DRG
- S DIE="^APCD3MV(",DA=APCD3IEN,DR=".03///"_APCD3DRG
- D ^DIE
- I $D(Y) S APCD3MER="220^Error adding DRG to 3M file" D ERR
- Q
- ;
- ICPT ;-- file cpt codes
- S X=APCD3COD_" - "_APCD3TXT ;file cpt and text
- S DA(1)=APCD3IEN,DIC="^APCD3MV("_DA(1)_",13,",DIC(0)="L",DIC("P")=$P(^DD(9001001.9,1301,0),U,2)
- I $G(APCD3MOD)?.N S DIC("DR")=".02////"_$G(APCD3MOD)
- D FILE
- Q
- ;
- DISPCPT ;-- display the cpt picklist for user
- S APCDDA=0 F I=1:1 S APCDDA=$O(^APCD3MV(APCDVSIT,13,APCDDA)) Q:'APCDDA D
- . S APCD3CPT=$P($G(^APCD3MV(APCDVSIT,13,APCDDA,0)),U)
- . S APCD3MOD=$P($G(^APCD3MV(APCDVSIT,13,APCDDA,0)),U,2)
- . W !,$G(I)_") Cpt: "_$G(APCD3CPT)_$S($G(APCD3MOD)'="":" Modifier: "_$G(APCD3MOD),1:"")
- . S APCDCPTA(I)=APCDDA_U_APCD3CPT_U_APCD3MOD
- Q:'$O(APCDCPTA(""))
- S APCDPCPT=""
- R !!,"Which CPT should I attach to this procedure: ",APCDRX:DTIME
- Q:APCDRX="^"
- Q:APCDRX=""
- I '$G(APCDCPTA(APCDRX)) W !,"Not a valid Selection, Try Again." G DISPCPT
- S APCDUCPT=$P($G(APCDCPTA(APCDRX)),U)
- ;S APCDPCPT=$P($G(APCDCPTA(APCDRX)),U,2) ;cmi/anch/maw 3/6/2007 orig line
- S APCDPCPT=+$P($G(APCDCPTA(APCDRX)),U,2) ;cmi/anch/maw 3/6/2007 modified
- S APCDPMOD=$P($G(APCDPMOD(APCDRX)),U,3)
- ;I $G(APCDPCPT)'="" S APCDPCPT=$O(^ICPT("B",APCDPCPT,0))
- I $G(APCDPCPT)'="" S APCDPCPT=$P($$CPT^ICPTCOD(APCDPCPT),U,1)
- I APCDPCPT=-1 S APCDPCPT=""
- I APCDPCPT'="" S APCDPCPT="`"_APCDPCPT
- I $G(APCDPMOD)'="" D
- .I $$VERSION^XPDUTL("BCSV")>0 S APCDPMOD=$O(^DIC(81.3,APCDPMOD,0)) Q
- .S APCDPMOD=$O(^AUTTCMOD("B",APCDPMOD,0))
- I APCDPMOD'="" S APCDPMOD="`"_APCDPMOD
- ;maw kill these cpt's after the template
- S APCDCPTU(APCDUCPT)=APCDVSIT ;set variable since they were picked
- Q
- ;
- DISPICD ;-- display the icd code picklist for user
- S APCDPDA=0 F I=1:1 S APCDPDA=$O(^AUPNVPOV("AD",APCDVSIT,APCDPDA)) Q:'APCDPDA D
- . Q:'$G(^AUPNVPOV(APCDPDA,0))
- . S APCDDXI=$P(^AUPNVPOV(APCDPDA,0),U)
- . Q:APCDDXI=""
- . ;Q:'$G(^ICD9(APCDDXI,0)) ;cmi/anch/maw 3/6/2007 orig line
- . ;Q:'$D(^ICD9(APCDDXI,0)) ;cmi/anch/maw 3/6/2007 not picking up v codes
- . Q:$P($$ICDDX^ICDEX(APCDDXI),U,1)<0
- . ;S APCDDXC=$P(^ICD9(APCDDXI,0),U)
- . S APCDDXC=$P($$ICDDX^ICDEX(APCDDXI,$$VD^APCLV(APCDVSIT)),U,2)
- . ;S APCDDXE=$G(^ICD9(APCDDXI,1))
- . S APCDDXE=$P($$ICDDX^ICDEX(APCDDXI,$$VD^APCLV(APCDVSIT)),U,4)
- . W !,$G(I)_") Dx Code: "_$G(APCDDXC)_" Dx Desc: "_$G(APCDDXE)
- . S APCDICDA(I)=APCDPDA_U_APCDDXC
- Q:'$O(APCDICDA(""))
- S APCDPICD=""
- R !!,"Which DX should I attach to this procedure: ",APCDIRX:DTIME
- Q:APCDIRX="^"
- Q:APCDIRX=""
- I '$G(APCDICDA(APCDIRX)) W !,"Not a valid Selection, Try Again." G DISPICD
- S APCDPICD=$P($G(APCDICDA(APCDIRX)),U,2)
- I $G(APCDPICD)'="" S APCDPICD=+$$CODEN^ICDEX(APCDPICD,80) I $P(APCDPICD,U)=-1 S APCDPICD=""
- I APCDPICD'="" S APCDPICD="`"_APCDPICD
- Q
- ;
- DISPECD ;-- display the ecode picklist for user
- S APCDI=1
- S APCDDA=0 F S APCDDA=$O(^APCD3MV(APCDVSIT,11,APCDDA)) Q:'APCDDA D
- . S APCD3ECD=$P($G(^APCD3MV(APCDVSIT,11,APCDDA,0)),U)
- . Q:$E(APCD3ECD,1,1)'="E"
- . W !,$G(APCDI)_") E Code: "_$G(APCD3ECD)
- . S APCDECDA(APCDI)=APCDDA_U_APCD3ECD
- . S APCDI=APCDI+1
- Q:'$O(APCDECDA(""))
- S APCDPECD=""
- R !!,"Which E Code should I attach to this diagnosis: ",APCDEX:DTIME
- Q:APCDEX="^"
- Q:APCDEX=""
- I '$G(APCDECDA(APCDEX)) W !,"Not a valid Selection, Try Again." G DISPECD
- S APCDUECD=$P($G(APCDECDA(APCDEX)),U)
- S APCDPECD=$P($G(APCDECDA(APCDEX)),U,2)
- I $G(APCDPECD)'="" S APCDCECD=+$$CODEN^ICDEX(APCDPECD,80) I $P(APCDCECD,U)=-1 S APCDCECD=""
- I APCDCECD="" S APCDPECD=""
- ;I APCDPECD'="" S APCDPECD="`"_APCDPECD
- Q
- ;
- FILE ; CALL FILE^DICN
- K DD,DO
- D FILE^DICN
- K D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM
- Q
- ;
- UPDCODE ;-- add ecode to coded entry
- Q:'$G(APCDDG1)
- S DA=$G(APCDDG1)
- Q:$P($G(^APCD3MV(APCD3IEN,11,DA,0)),U,4) ;e code exists
- S DA(1)=APCD3IEN,DIE="^APCD3MV("_DA(1)_",11,",DR=".04////"_APCDECOD
- D ^DIE
- Q
- ;
- OUT(APCDVSIT) ; EP - SEND HL7 MESSAGE TO 3M CODER
- ; called by PCC Data Entry and ADT Data Entry
- D OUTMAIN
- I $G(APCD3MER) D ERR
- Q
- ;
- OUTMAIN ; OUTBOUND MAINLINE LOGIC
- D OUTINIT ; initialization/check protocol
- D GEN^APCD3MG(APCDVSIT)
- Q:$G(APCD3MER)
- Q:APCDQ
- S APCDIP=$G(APCD3MIP)
- S BHLIP=APCDIP ;needed for protocol
- W !!,"Now Sending to 3M"
- S APCDBP=$O(^INTHPC("B","HL IHS 3M SENDER "_BHLIP,0))
- Q:'APCDBP
- F APCDJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER" D
- . S APCDY=$$CHK^BHLBCK(APCDJOB,"")
- D CLNDST(BHLIP) ;12/2/2005 maw added to eliminate duplicate sends
- S APCDMSG=$$A^INHB(APCDBP)
- S X="BHL SEND TO 3M",DIC=101 D EN^XQOR
- Q
- ;
- CLNDST(IP) ;-- cleanout destination queue before creating message
- N BHLDST
- S BHLDST=$O(^INRHD("B","HL IHS 3M CODER "_IP,0))
- Q:'BHLDST
- K ^INLHDEST(BHLDST)
- Q
- ;
- OUTINIT ; OUTBOUND INITIALIZATION
- S APCDQ=1
- D:$G(APCD3MIP)="" OUTGETIP ; get IP address
- S APCDQ=0
- Q
- ;
- OUTGETIP ; GET IP ADDRESS
- I $G(APCD3MIP)="" D
- . W !
- . S DIR(0)="FO^1:2",DIR("A")="Enter your 3M Workstation ID "
- . KILL DA D ^DIR KILL DIR
- . S APCD3MIP=$G(X)
- . Q
- I APCD3MIP="" S APCD3MER="101^No ID address entered" D ERR Q
- Q
- ;
- ERR ;-- log the error here
- W !,$P($G(APCD3MER),U,2) Q ;maw needs work
- S APCDERR="D TRAP^BHLERR"
- I $G(APCD3MER)="GEN" D
- . S BHLEFL=APCDEFL
- . S BHLFLD=APCDFLD
- I $P($G(APCD3MER),U,2)]"" S APCD3MER="GEN"
- S BHLERCD=APCD3MER X APCDERR
- Q
- ;
- EOJ ;-- kill variables
- D EN^XBVK("APCD")
- Q
- ;
- APCD3M ; IHS/CMI/LAB - PCC TO 3M CODER INTERFACE ;
- +1 ;;2.0;IHS PCC SUITE;**2,11**;MAY 14, 2009;Build 58
- +2 ;;2.0
- +3 ;
- +4 ; This routine processes inbound HL7 messages from the 3M Coder
- +5 ; and generates outbound HL7 messages to send to the 3M Coder.
- +6 ;
- +7 ; The entry point IN is called by the HL7 package to process
- +8 ; an inbound message from the 3M Coder. An entry is generated
- +9 ; in file 9001001.9 for the specified visit which contains the
- +10 ; ICD codes and provider narratives required to generate the
- +11 ; appropriate V POV and V PROCEDURE entries for this visit.
- +12 ;
- +13 ; The entry point OUT is called to generate an HL7 message
- +14 ; containing patient demographic and medical data required
- +15 ; by the 3M Coder to assign ICD codes to V POV entries. The
- +16 ; visit IEN is passed in APCDVSIT.
- +17 ;
- +18 ;cmi/anch/maw 10/11/2005 modified due to change in 3m structure
- +19 ;cmi/anch/maw 12/2/2005 maw added clean of destination queue before sending
- +20 ;cmi/anch/maw 3/6/2007 maw modified DISPCPT to screen off description
- +21 ;cmi/anch/maw 3/6/2007 maw modified DISPICD to get if a V code
- +22 ;cmi/tucson/lab 11/12/2007 code set versioning
- +23 ;
- +24 ;do not enter at top of routine
- QUIT
- +25 ;
- IN ; EP - PROCESS HL7 MESSAGE FROM 3M CODER
- +1 ;maw this is where the inbound stuff starts
- +2 NEW APCD3COD,APCD3IEN,APCD3NAR,APCDQ,I,J,X,Y
- +3 DO INMAIN
- +4 DO EOJ
- +5 QUIT
- +6 ;
- INMAIN ; INBOUND MAINLINE LOGIC
- +1 ; generate 9001001.9 entry
- DO INSTALL
- +2 QUIT
- +3 ;
- INSTALL ; GENERATE 9001001.9 ENTRY
- +1 FOR J=1:1
- SET X=$GET(APCDHL7M(J))
- IF X=""
- QUIT
- Begin DoDot:1
- +2 ; get segment
- SET Y=$PIECE(X,"|")
- +3 ; pv1 segment
- IF Y="PV1"
- DO IPV1
- QUIT
- +4 ; dg1 segment
- IF Y="DG1"
- DO IDG1
- QUIT
- +5 ; pr1 segment
- IF Y="PR1"
- DO IPR1
- QUIT
- +6 ; drg segment
- IF Y="DRG"
- DO IDRG
- QUIT
- +7 QUIT
- End DoDot:1
- IF $GET(APCD3MER)
- QUIT
- +8 QUIT
- +9 ;
- IPV1 ; PV1 SEGMENT
- +1 SET X=$PIECE(X,"|",20)
- +2 IF 'X
- SET APCD3MER="200^No Visit IEN in Message"
- DO ERR
- QUIT
- +3 SET DIC="^APCD3MV("
- SET DIC(0)="L"
- SET DLAYGO=9001001.9
- SET DIC("DR")=".02////"_UIF
- +4 SET DINUM=X
- +5 DO FILE
- +6 IF Y<0
- SET APCD3MER="100^Error adding message to 3M file"
- DO ERR
- QUIT
- +7 SET APCD3IEN=+Y
- +8 QUIT
- +9 ;
- IDG1 ; DG1 SEGMENT
- +1 ; get ICD9 code
- SET APCD3COD=$PIECE($PIECE(X,"|",4),U)
- +2 ;icd desc
- SET APCD3TXT=$PIECE($PIECE(X,"|",4),U,2)
- +3 ;diagnosis type
- SET APCD3DTP=$PIECE(X,"|",7)
- +4 ;don't file admit dx
- IF $GET(APCD3DTP)="A"
- QUIT
- +5 ;I $E(APCD3COD,1,1)="E" S APCDECOD=APCD3COD D Q
- +6 ;. I APCDECOD'["." S APCDECOD=$E(APCDECOD,1,4)_"."_$E(APCDECOD,5,999)
- +7 ;. D UPDCODE Q
- +8 IF $EXTRACT(APCD3COD,1,1)="E"
- Begin DoDot:1
- +9 IF APCD3COD'["."
- SET APCD3COD=$EXTRACT(APCD3COD,1,4)_"."_$EXTRACT(APCD3COD,5,999)
- End DoDot:1
- +10 IF $EXTRACT(APCD3COD,1,1)'="E"
- Begin DoDot:1
- +11 IF APCD3COD'["."
- SET APCD3COD=$EXTRACT(APCD3COD,1,3)_"."_$EXTRACT(APCD3COD,4,999)
- End DoDot:1
- +12 IF APCD3COD=""
- SET APCD3MER="204^POV ICD9 code missing"
- QUIT
- +13 SET X=APCD3COD
- SET DA(1)=APCD3IEN
- SET DIC="^APCD3MV("_DA(1)_",11,"
- SET DIC(0)="L"
- SET DIC("P")=$PIECE(^DD(9001001.9,1101,0),U,2)
- +14 SET DIC("DR")=".02///"_$GET(APCD3TXT)
- +15 DO FILE
- +16 IF Y<0
- SET APCD3MER="210^Error adding POV to 3M file"
- DO ERR
- QUIT
- +17 SET APCDDG1=+Y
- +18 QUIT
- +19 ;
- IPR1 ; PR1 SEGMENT
- +1 ; get ICD9 code
- SET APCD3COD=$PIECE($PIECE(X,"|",4),U)
- +2 ; cpt description
- SET APCD3TXT=$PIECE($PIECE(X,"|",4),U,2)
- +3 ; get type of coding system
- SET APCDCTP=$PIECE($PIECE(X,"|",4),U,3)
- +4 ; get modifier
- SET APCD3MOD=$PIECE(X,"|",17)
- +5 IF APCD3COD=""
- SET APCD3MER="208^PROC ICD9 code missing"
- QUIT
- +6 ;goto cpt filer then quit
- IF $GET(APCDCTP)="CP"
- DO ICPT
- QUIT
- +7 ;hcps codes
- IF $GET(APCDCTP)="H"
- DO ICPT
- QUIT
- +8 ;non icd codes
- IF $EXTRACT(APCD3COD,1)'?.N
- DO ICPT
- QUIT
- +9 ;I $L(APCD3COD)>4 D ICPT Q ;cpt codes 10/25/2005 maw commented out
- +10 IF APCD3COD'["."
- SET APCD3COD=$EXTRACT(APCD3COD,1,2)_"."_$EXTRACT(APCD3COD,3,999)
- +11 SET X=APCD3COD
- SET DA(1)=APCD3IEN
- SET DIC="^APCD3MV("_DA(1)_",12,"
- SET DIC(0)="L"
- SET DIC("P")=$PIECE(^DD(9001001.9,1201,0),U,2)
- +12 SET DIC("DR")=".02///"_$GET(APCD3TXT)
- +13 DO FILE
- +14 IF Y<0
- SET APCD3MER="211^Error adding Procedure to 3M file"
- DO ERR
- QUIT
- +15 SET APCDPR1=+Y
- +16 QUIT
- +17 ;
- IDRG ;-- get the drg
- +1 SET APCD3DRG=$PIECE(X,"|",2)
- +2 IF APCD3DRG'=""
- SET APCD3DRG="DRG"_+APCD3DRG
- +3 SET DIE="^APCD3MV("
- SET DA=APCD3IEN
- SET DR=".03///"_APCD3DRG
- +4 DO ^DIE
- +5 IF $DATA(Y)
- SET APCD3MER="220^Error adding DRG to 3M file"
- DO ERR
- +6 QUIT
- +7 ;
- ICPT ;-- file cpt codes
- +1 ;file cpt and text
- SET X=APCD3COD_" - "_APCD3TXT
- +2 SET DA(1)=APCD3IEN
- SET DIC="^APCD3MV("_DA(1)_",13,"
- SET DIC(0)="L"
- SET DIC("P")=$PIECE(^DD(9001001.9,1301,0),U,2)
- +3 IF $GET(APCD3MOD)?.N
- SET DIC("DR")=".02////"_$GET(APCD3MOD)
- +4 DO FILE
- +5 QUIT
- +6 ;
- DISPCPT ;-- display the cpt picklist for user
- +1 SET APCDDA=0
- FOR I=1:1
- SET APCDDA=$ORDER(^APCD3MV(APCDVSIT,13,APCDDA))
- IF 'APCDDA
- QUIT
- Begin DoDot:1
- +2 SET APCD3CPT=$PIECE($GET(^APCD3MV(APCDVSIT,13,APCDDA,0)),U)
- +3 SET APCD3MOD=$PIECE($GET(^APCD3MV(APCDVSIT,13,APCDDA,0)),U,2)
- +4 WRITE !,$GET(I)_") Cpt: "_$GET(APCD3CPT)_$SELECT($GET(APCD3MOD)'="":" Modifier: "_$GET(APCD3MOD),1:"")
- +5 SET APCDCPTA(I)=APCDDA_U_APCD3CPT_U_APCD3MOD
- End DoDot:1
- +6 IF '$ORDER(APCDCPTA(""))
- QUIT
- +7 SET APCDPCPT=""
- +8 READ !!,"Which CPT should I attach to this procedure: ",APCDRX:DTIME
- +9 IF APCDRX="^"
- QUIT
- +10 IF APCDRX=""
- QUIT
- +11 IF '$GET(APCDCPTA(APCDRX))
- WRITE !,"Not a valid Selection, Try Again."
- GOTO DISPCPT
- +12 SET APCDUCPT=$PIECE($GET(APCDCPTA(APCDRX)),U)
- +13 ;S APCDPCPT=$P($G(APCDCPTA(APCDRX)),U,2) ;cmi/anch/maw 3/6/2007 orig line
- +14 ;cmi/anch/maw 3/6/2007 modified
- SET APCDPCPT=+$PIECE($GET(APCDCPTA(APCDRX)),U,2)
- +15 SET APCDPMOD=$PIECE($GET(APCDPMOD(APCDRX)),U,3)
- +16 ;I $G(APCDPCPT)'="" S APCDPCPT=$O(^ICPT("B",APCDPCPT,0))
- +17 IF $GET(APCDPCPT)'=""
- SET APCDPCPT=$PIECE($$CPT^ICPTCOD(APCDPCPT),U,1)
- +18 IF APCDPCPT=-1
- SET APCDPCPT=""
- +19 IF APCDPCPT'=""
- SET APCDPCPT="`"_APCDPCPT
- +20 IF $GET(APCDPMOD)'=""
- Begin DoDot:1
- +21 IF $$VERSION^XPDUTL("BCSV")>0
- SET APCDPMOD=$ORDER(^DIC(81.3,APCDPMOD,0))
- QUIT
- +22 SET APCDPMOD=$ORDER(^AUTTCMOD("B",APCDPMOD,0))
- End DoDot:1
- +23 IF APCDPMOD'=""
- SET APCDPMOD="`"_APCDPMOD
- +24 ;maw kill these cpt's after the template
- +25 ;set variable since they were picked
- SET APCDCPTU(APCDUCPT)=APCDVSIT
- +26 QUIT
- +27 ;
- DISPICD ;-- display the icd code picklist for user
- +1 SET APCDPDA=0
- FOR I=1:1
- SET APCDPDA=$ORDER(^AUPNVPOV("AD",APCDVSIT,APCDPDA))
- IF 'APCDPDA
- QUIT
- Begin DoDot:1
- +2 IF '$GET(^AUPNVPOV(APCDPDA,0))
- QUIT
- +3 SET APCDDXI=$PIECE(^AUPNVPOV(APCDPDA,0),U)
- +4 IF APCDDXI=""
- QUIT
- +5 ;Q:'$G(^ICD9(APCDDXI,0)) ;cmi/anch/maw 3/6/2007 orig line
- +6 ;Q:'$D(^ICD9(APCDDXI,0)) ;cmi/anch/maw 3/6/2007 not picking up v codes
- +7 IF $PIECE($$ICDDX^ICDEX(APCDDXI),U,1)<0
- QUIT
- +8 ;S APCDDXC=$P(^ICD9(APCDDXI,0),U)
- +9 SET APCDDXC=$PIECE($$ICDDX^ICDEX(APCDDXI,$$VD^APCLV(APCDVSIT)),U,2)
- +10 ;S APCDDXE=$G(^ICD9(APCDDXI,1))
- +11 SET APCDDXE=$PIECE($$ICDDX^ICDEX(APCDDXI,$$VD^APCLV(APCDVSIT)),U,4)
- +12 WRITE !,$GET(I)_") Dx Code: "_$GET(APCDDXC)_" Dx Desc: "_$GET(APCDDXE)
- +13 SET APCDICDA(I)=APCDPDA_U_APCDDXC
- End DoDot:1
- +14 IF '$ORDER(APCDICDA(""))
- QUIT
- +15 SET APCDPICD=""
- +16 READ !!,"Which DX should I attach to this procedure: ",APCDIRX:DTIME
- +17 IF APCDIRX="^"
- QUIT
- +18 IF APCDIRX=""
- QUIT
- +19 IF '$GET(APCDICDA(APCDIRX))
- WRITE !,"Not a valid Selection, Try Again."
- GOTO DISPICD
- +20 SET APCDPICD=$PIECE($GET(APCDICDA(APCDIRX)),U,2)
- +21 IF $GET(APCDPICD)'=""
- SET APCDPICD=+$$CODEN^ICDEX(APCDPICD,80)
- IF $PIECE(APCDPICD,U)=-1
- SET APCDPICD=""
- +22 IF APCDPICD'=""
- SET APCDPICD="`"_APCDPICD
- +23 QUIT
- +24 ;
- DISPECD ;-- display the ecode picklist for user
- +1 SET APCDI=1
- +2 SET APCDDA=0
- FOR
- SET APCDDA=$ORDER(^APCD3MV(APCDVSIT,11,APCDDA))
- IF 'APCDDA
- QUIT
- Begin DoDot:1
- +3 SET APCD3ECD=$PIECE($GET(^APCD3MV(APCDVSIT,11,APCDDA,0)),U)
- +4 IF $EXTRACT(APCD3ECD,1,1)'="E"
- QUIT
- +5 WRITE !,$GET(APCDI)_") E Code: "_$GET(APCD3ECD)
- +6 SET APCDECDA(APCDI)=APCDDA_U_APCD3ECD
- +7 SET APCDI=APCDI+1
- End DoDot:1
- +8 IF '$ORDER(APCDECDA(""))
- QUIT
- +9 SET APCDPECD=""
- +10 READ !!,"Which E Code should I attach to this diagnosis: ",APCDEX:DTIME
- +11 IF APCDEX="^"
- QUIT
- +12 IF APCDEX=""
- QUIT
- +13 IF '$GET(APCDECDA(APCDEX))
- WRITE !,"Not a valid Selection, Try Again."
- GOTO DISPECD
- +14 SET APCDUECD=$PIECE($GET(APCDECDA(APCDEX)),U)
- +15 SET APCDPECD=$PIECE($GET(APCDECDA(APCDEX)),U,2)
- +16 IF $GET(APCDPECD)'=""
- SET APCDCECD=+$$CODEN^ICDEX(APCDPECD,80)
- IF $PIECE(APCDCECD,U)=-1
- SET APCDCECD=""
- +17 IF APCDCECD=""
- SET APCDPECD=""
- +18 ;I APCDPECD'="" S APCDPECD="`"_APCDPECD
- +19 QUIT
- +20 ;
- FILE ; CALL FILE^DICN
- +1 KILL DD,DO
- +2 DO FILE^DICN
- +3 KILL D,D0,D1,DA,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM
- +4 QUIT
- +5 ;
- UPDCODE ;-- add ecode to coded entry
- +1 IF '$GET(APCDDG1)
- QUIT
- +2 SET DA=$GET(APCDDG1)
- +3 ;e code exists
- IF $PIECE($GET(^APCD3MV(APCD3IEN,11,DA,0)),U,4)
- QUIT
- +4 SET DA(1)=APCD3IEN
- SET DIE="^APCD3MV("_DA(1)_",11,"
- SET DR=".04////"_APCDECOD
- +5 DO ^DIE
- +6 QUIT
- +7 ;
- OUT(APCDVSIT) ; EP - SEND HL7 MESSAGE TO 3M CODER
- +1 ; called by PCC Data Entry and ADT Data Entry
- +2 DO OUTMAIN
- +3 IF $GET(APCD3MER)
- DO ERR
- +4 QUIT
- +5 ;
- OUTMAIN ; OUTBOUND MAINLINE LOGIC
- +1 ; initialization/check protocol
- DO OUTINIT
- +2 DO GEN^APCD3MG(APCDVSIT)
- +3 IF $GET(APCD3MER)
- QUIT
- +4 IF APCDQ
- QUIT
- +5 SET APCDIP=$GET(APCD3MIP)
- +6 ;needed for protocol
- SET BHLIP=APCDIP
- +7 WRITE !!,"Now Sending to 3M"
- +8 SET APCDBP=$ORDER(^INTHPC("B","HL IHS 3M SENDER "_BHLIP,0))
- +9 IF 'APCDBP
- QUIT
- +10 FOR APCDJOB="FORMAT CONTROLLER","OUTPUT CONTROLLER"
- Begin DoDot:1
- +11 SET APCDY=$$CHK^BHLBCK(APCDJOB,"")
- End DoDot:1
- +12 ;12/2/2005 maw added to eliminate duplicate sends
- DO CLNDST(BHLIP)
- +13 SET APCDMSG=$$A^INHB(APCDBP)
- +14 SET X="BHL SEND TO 3M"
- SET DIC=101
- DO EN^XQOR
- +15 QUIT
- +16 ;
- CLNDST(IP) ;-- cleanout destination queue before creating message
- +1 NEW BHLDST
- +2 SET BHLDST=$ORDER(^INRHD("B","HL IHS 3M CODER "_IP,0))
- +3 IF 'BHLDST
- QUIT
- +4 KILL ^INLHDEST(BHLDST)
- +5 QUIT
- +6 ;
- OUTINIT ; OUTBOUND INITIALIZATION
- +1 SET APCDQ=1
- +2 ; get IP address
- IF $GET(APCD3MIP)=""
- DO OUTGETIP
- +3 SET APCDQ=0
- +4 QUIT
- +5 ;
- OUTGETIP ; GET IP ADDRESS
- +1 IF $GET(APCD3MIP)=""
- Begin DoDot:1
- +2 WRITE !
- +3 SET DIR(0)="FO^1:2"
- SET DIR("A")="Enter your 3M Workstation ID "
- +4 KILL DA
- DO ^DIR
- KILL DIR
- +5 SET APCD3MIP=$GET(X)
- +6 QUIT
- End DoDot:1
- +7 IF APCD3MIP=""
- SET APCD3MER="101^No ID address entered"
- DO ERR
- QUIT
- +8 QUIT
- +9 ;
- ERR ;-- log the error here
- +1 ;maw needs work
- WRITE !,$PIECE($GET(APCD3MER),U,2)
- QUIT
- +2 SET APCDERR="D TRAP^BHLERR"
- +3 IF $GET(APCD3MER)="GEN"
- Begin DoDot:1
- +4 SET BHLEFL=APCDEFL
- +5 SET BHLFLD=APCDFLD
- End DoDot:1
- +6 IF $PIECE($GET(APCD3MER),U,2)]""
- SET APCD3MER="GEN"
- +7 SET BHLERCD=APCD3MER
- XECUTE APCDERR
- +8 QUIT
- +9 ;
- EOJ ;-- kill variables
- +1 DO EN^XBVK("APCD")
- +2 QUIT
- +3 ;
