Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMEREDDX

AMEREDDX.m

Go to the documentation of this file. 
  1. AMEREDDX ; IHS/OIT/SCR - Sub-routine for ER VISIT EDIT of DX information
  1.  ;;3.0;ER VISIT SYSTEM;**2,3**;DEC 07, 2011;Build 11
  1.  ;
  1.  ; VARIABLES: The following variables are passed to multiple editing routines
  1.  ;  AMERDA  : the IEN of the ER VISIT that is selected for editing
  1.  ;  AMERAIEN: The IEN of the ER AUDIT that is created when user begins editing a record
  1.  ;  AMEREDNO: An integer representing the number of multiple fields that have been edited
  1.  ;            for uniqueness in multiple field number in audit file
  1.  ; Edit Auditing VARIABLES newed and used throughout edit routines:
  1.  ;      AMEROLD : original value of edited field
  1.  ;      AMERNEW : new value of edited field
  1.  ;      AMERSTRG : A ";" deliminated string of edit information for a field
  1.  ;      
  1. EDDIAGS(AMERDA,AMEREDNO,AMERAIEN) ; EP from AMEREDIT 
  1.  ;
  1.  I '$D(^XUSEC("AMERZ9999",DUZ)) D EN^DDIOL("You are not authorized to use this option","","!!") Q 1  ;PROGRAMATICALLY LOCKING this option to holders of the coding key
  1.  ; AMERDXNO - counter that identifies a multiple DX entry for subsequent matching
  1.  ; AMERPDX - the ICD9 code that has been identified as the primary DX:
  1.  ; AMERNAR - a string containing the narrative that has been identified by user
  1.  ; AMERDX  - a pointer to the ICD9 file that has been selected by user
  1.  N AMERDXNO,Y,AMERPDX,AMERPNAR,AMERNAR,AMERDX,DIC,AMERDONE,AMERQUIT,AMERPRIM,AMERSEL,AMERCODE
  1.  S (AMERQUIT,AMERDXNO)=0
  1.  S (Y,AMERPDX,AMERNAR,AMERDX,AMERDONE)=""
  1.  D EN^DDIOL("","","!")
  1.  I $P($G(^AMERVSIT(AMERDA,5.1)),U,2)="" S AMERPDX=""
  1.  I $P($G(^AMERVSIT(AMERDA,5.1)),U,3)="" S AMERPNAR=""
  1.  ;IHS/OIT/SCR 11/20/08 modify function that screens valid codes to allow 'LOCAL CODES'
  1.  ;I $P($G(^AMERVSIT(AMERDA,5.1)),U,2)'="" S AMERPDX=$P($$ICDDX^ICDCODE($P($G(^AMERVSIT(AMERDA,5.1)),U,2),0),U,2)
  1.  I $P($G(^AMERVSIT(AMERDA,5.1)),U,2)'="" S AMERPDX=$P($$ICDDX^ICDCODE($P($G(^AMERVSIT(AMERDA,5.1)),U,2),,,1),U,2)
  1.  I $P($G(^AMERVSIT(AMERDA,5.1)),U,3)'="" S AMERPNAR=$P(^AMERVSIT(AMERDA,5.1),U,3)
  1.  F  Q:AMERDONE="^"  D
  1.  .D ^XBCLS
  1.  .;IHS/OIT/SCR 11/03/08 allow selection of ICD9 code by number START CHANGES
  1.  .;D DSPLYDX(AMERPDX,AMERPNAR)
  1.  .S AMERSEL=$$SELECTDX(AMERPDX,AMERPNAR)
  1.  .I AMERSEL=-1 S AMERDONE="^" Q
  1.  .I (AMERSEL>0) S AMERCODE=$P($$ICDDX^ICDCODE($G(^AMERVSIT(AMERDA,5,AMERSEL,0)),,,1),U,2)
  1.  .S DIC("A")=""
  1.  .S DIC("B")=""
  1.  .D EN^DDIOL("","","!")
  1.  .I (AMERSEL'=0) D
  1.  ..S DIC("B")=AMERCODE
  1.  ..S DIC("A")="MODIFY INFORMATION FOR ICD9 CODE: "
  1.  ..S DIC(0)="ME",X=AMERCODE ;
  1.  .E  S DIC("A")="ENTER ICD9 CODE TO ADD: ",DIC(0)="AMEQ"
  1.  .S DIC="^ICD9(",Y="" ; 
  1.  .;Screen ICD9 codes so that only those that will create a V POV entry can be selected
  1.  .; this screen comes from the .01 field of the V POV file
  1.  .S DIC("S")="D ^AUPNSICD"
  1.  .D ^DIC
  1.  .I $D(DUOUT)!$D(DTOUT) S AMERDONE="^" Q
  1.  .S AMERDX=Y
  1.  .I AMERDX>0 D
  1.  ..;S AMEREDNO=AMEREDNO+1  ; Tracking the edit number for "field" uniqueness in ^AMERAUDT
  1.  ..S AMERPRIM=$$PROCESDX(AMERSEL,AMERDX,AMERPDX,AMERPNAR)
  1.  ..I AMERPRIM'="" S AMERPDX=$P(AMERPRIM,U,1),AMERPNAR=$P(AMERPRIM,U,2)
  1.  ..D EN^DDIOL("   ","","!!")
  1.  ..Q
  1.  .E  I AMERDX=-1 S AMERDONE="^"
  1.  K AMERDXNO,Y,AMERNAR,AMERDX,DIC,AMERDONE
  1.  ;I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0  ;IHS/OIT/SCR 01/06/09
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT
  1.  I AMERQUIT=1 Q 0
  1.  Q 1
  1.  ;
  1. PRIMDIAG(AMERDA,AMERDX,AMERNNAR,AMERAIEN,AMERPRIS,AMEROLDS) ;
  1.  ; UPDATES PRIMARY DIAGNOSIS FIELDS IF THE ORIGINAL INFORMATION MATCHES PRIMARY DX INFORMATION
  1.  ; AND ALLOWS USER TO REPLACE PRIMARY DX FIELDS WITH NEW ONE'S IF ORIGINAL INFORMATION IS DIFFERENT
  1.  ;
  1.  ; INPUT:
  1.  ; AMERDA - THE IEN OF THE ER VISIT
  1.  ; AMERDX - THE DX CODE THAT IS BEING ENTERED
  1.  ; AMERNAR - THE DX NARRATIVE THAT IS BEING ENTERED
  1.  ; AMERAIEN - THE IEN OF THE ER AUDIT FILE
  1.  ; AMERPRIS - A "^" DELIMITED STRING CONTAINING: NEW PRIMARY ICD9^CURRENT PRIMARY NARRATIVE
  1.  ; AMEROLDS - A "^" DELIMITED STRING CONTAINING:  ORIGINAL ICD9^ORIGINAL NARRATIVE
  1.  ; RETURNS: A "^" DELEMITED STRING CONTAINING UPDATED PRIMARY ICD9^UPDATED PRIMARY NARRATIVE
  1.  N AMERSTRG,AMEREDTS,DR,AMERODX,AMERONAR,DIR,AMEROLD,AMERNEW,Y,AMERPNAR,AMERPDX,AMERTEMP
  1.  S Y=0
  1.  S AMERPDX=$P(AMERPRIS,U,1),AMERPNAR=$P(AMERPRIS,U,2)
  1.  S (AMERSTRG,AMEREDTS,DR,AMEROLD)=""
  1.  S AMERONAR=$P($G(^AMERVSIT(AMERDA,5.1)),U,3)
  1.  S AMERODX=$P($G(^AMERVSIT(AMERDA,5.1)),U,2)
  1.  I AMERODX="" S Y=1  ; IF THERE IS NO PRIMARY DX ENTERED, make this primary
  1.  I AMERODX'="" D
  1.  .S AMERTEMP=$P($$ICDDX^ICDCODE(AMERODX,,,1),U,2)
  1.  .I ($G(AMERPDX)=AMERTEMP)&(AMERPNAR=$P(AMEROLDS,U,2)) S Y=1
  1.  .Q
  1.  ; IF the original primary ICD9 code is what the old pointer points to AND the original narrative is the primary narrative
  1.  ; JUST UPDATE PRIMARY FIELDS, DON'T ASK
  1.  I Y=0 D
  1.  .S DIR("B")="NO"
  1.  .S DIR(0)="Y",DIR("A")="Is this the Primary DX"
  1.  .D ^DIR
  1.  .Q
  1.  I $G(Y)>0 D
  1.  .I AMERODX'=AMERDX D
  1.  ..;IHS/OIT/SCR 11/20/09 MODIFYING FUNCTION THAT SCREENS VALID CODES TO ALLOW 'LOCAL'
  1.  ..;S:AMERODX'="" AMEROLD=$P($$ICDDX^ICDCODE(AMERODX),U,2)
  1.  ..S:AMERODX'="" AMEROLD=$P($$ICDDX^ICDCODE(AMERODX,,,1),U,2)
  1.  ..S AMERNEW=$P($$ICDDX^ICDCODE(AMERDX,,,1),U,2)
  1.  ..S AMERPDX=AMERNEW
  1.  ..D NOW^%DTC  ; FM datetime returned in X
  1.  ..S AMERSTRG="5.2."_AMEREDNO_";"_X_";"_$$EDDISPL^AMEREDAU(AMEROLD,"X")_";"_$$EDDISPL^AMEREDAU(AMERNEW,"X")_";"_"Administrative;PRIMARY DIAGNOSIS;Silent audit trail"
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_"5.2////"_AMERDX  ; UPDATE POINTER
  1.  ..Q
  1.  .Q:AMERSTRG="^"
  1.  .I AMERONAR'=AMERNNAR D
  1.  ..S AMERPNAR=AMERNNAR
  1.  ..D NOW^%DTC  ; FM date time returned in X
  1.  ..S AMERSTRG="5.3."_AMEREDNO_";"_X_";"_AMERONAR_";"_AMERPNAR_";Administrative;PRIMARY DX NARRATIVE;Silent Audit Trail"
  1.  ..I AMERSTRG="^" Q
  1.  ..S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ..S DR=$S(DR'="":DR_";",1:""),DR=DR_"5.3////"_AMERNNAR  ; Update narrative
  1.  ..Q
  1.  .Q
  1.  D:DR'="" DIE^AMEREDIT(AMERDA,DR)
  1.  D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  K AMERSTRG,AMEREDTS,DR,AMERODX,AMERONAR,DIR
  1.  Q AMERPDX_"^"_AMERPNAR
  1.  ;
  1. DELDIAG(AMERIEN,AMERSUB) ;
  1.  ; Delete diagnosis record
  1.  N DIR,DIK,AMERFLAG
  1.  S (AMERSTRG,AMEREDTS)=""
  1.  S DIR(0)="Y",DIR("A")="Do you want to delete this DX completely",DIR("B")="NO"
  1.  D ^DIR K DIR
  1.  S AMERFLAG=0
  1.  I $G(Y)>0 D
  1.  .S DA(1)=AMERIEN,DA=AMERSUB
  1.  .; First, delete the V POV entry to insure that it is synch'd with the ER VISIT file ; IHS/OIT/GIS 11/30/11
  1.  .D DELVPOV^AMEREDDY(AMERIEN,AMERSUB)
  1.  .;IHS/OIT/SCR 02/03/09 LET'S GET THIS DELETE RIGHT
  1.  .S DIK="^AMERVSIT("_DA(1)_",5,"
  1.  .D ^DIK,EN^DIK  ; Delete identified entry and re-index diagnosis field
  1.  .S AMERFLAG=1
  1.  .Q
  1.  K DIR,DIK
  1.  Q AMERFLAG
  1.  ;
  1. PROCESDX(AMERDXNO,AMERDIAG,AMERPDX,AMERPNAR) ;
  1.  ;
  1.  ; INPUT: AMERDXNO - The number of the diagnosis record that was selected for editing - 0 IF NEW
  1.  ;        AMERDIAG - Pointer to the ICD9 code that was selected
  1.  ;        AMERPDX - current primary DX ICD9 code for this visit
  1.  ;        AMERPNAR - current primary DX narrative
  1.  ;
  1.  ; RETURNS: AMERPRIM  - a "^" delimited string that contains the primary DX code and narrative
  1.  ;
  1.  ; First look to see if that DX has already been entered
  1.  ; if it has, we give the user a chance to delete it (if it isn't primary) or edit the narrative
  1.  N AMEREDTS,AMERSTRG,DR,AMERBAD,AMERPRIS,AMEROLDS
  1.  N AMERODX,AMERNDX,AMERONAR,AMERNNAR,AMERSKIP,AMERICD9,AMERGONE,AMERQUIT
  1.  N AMERGOOD  ;IHS/OIT/SCR 092909 patch 2
  1.  ;S AMERDIAG=$G(^AMERVSIT(AMERDA,5,AMERSEL,0))
  1.  S (AMERNDX,AMERODX,AMERONAR,AMERNNAR,AMEREDTS,AMERSTRG,DR,AMERODX)=""
  1.  ;S (AMERDXNO,AMERSKIP)=0,AMERDX=$P(AMERDIAG,U,1),AMERICD9=$P(AMERDIAG,U,2)
  1.  S AMERSKIP=0,AMERDX=$P(AMERDIAG,U,1),AMERICD9=$P(AMERDIAG,U,2)
  1.  S AMERQUIT=0
  1.  S AMERPRIS=AMERPDX_"^"_AMERPNAR ; Primary DX code and Narrative might change but must be returned
  1.  ;F  S AMERDXNO=$O(^AMERVSIT(AMERDA,5,AMERDXNO)) Q:AMERDXNO="B"!(AMERDXNO="")  I ^AMERVSIT(AMERDA,5,AMERDXNO,0)=AMERDX D
  1.  I AMERDXNO>0 D
  1.  .S AMERSKIP=1,AMERBAD=0,AMERGONE=0  ; Flags
  1.  .S AMERODX=AMERICD9  ; Keep diagnosis for audit trail
  1.  .D EN^DDIOL("Narrative: "_$G(^AMERVSIT(AMERDA,5,AMERDXNO,1)),"","!!")
  1.  .S AMERONAR=$G(^AMERVSIT(AMERDA,5,AMERDXNO,1))   ; Keep narrative for default
  1.  .S AMEROLDS=AMERODX_"^"_AMERONAR   ; Pass the old values for comparison with old primary values
  1.  .I AMERPDX=AMERICD9&(AMERPNAR=AMERONAR) D EN^DDIOL("**This is currently the Primary DX**","","!")
  1.  .D EN^DDIOL("","","!!")
  1.  .I '(AMERPDX=AMERICD9&(AMERPNAR=AMERONAR)) D
  1.  ..I $$DELDIAG(AMERDA,AMERDXNO)=1 D   ; DIAG record has been deleted
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("5-01"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMERODX,"X"),"","DIAGNOSIS")
  1.  ...I AMERSTRG="^" Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S AMERGONE=1
  1.  ...Q
  1.  ..I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1
  1.  ..Q
  1.  .Q:AMERQUIT  ; Quit if user "^" when asked if wants to delete
  1.  .I 'AMERGONE D    ; DX record NOT DELETED,can change code AND narrative
  1.  ..S DIR(0)="Y",DIR("A")="Do you want to change DX code",DIR("B")="YES"
  1.  ..D ^DIR K DIR
  1.  ..I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
  1.  ..I $G(Y)=0 S AMERNDX=AMERODX
  1.  ..I $G(Y)=1 D
  1.  ...;IHS/OIT/SCR 10/20/08
  1.  ...S DIC="^ICD9(",DIC(0)="AMEQ",Y="",DIC("S")="D ^AUPNSICD"
  1.  ...S DIC("A")="Enter NEW ICD Code: "
  1.  ...D ^DIC K DIC
  1.  ...I $D(DUOUT)!$D(DTOUT) S AMERDONE="^",AMERQUIT=1 Q
  1.  ...I Y<1 S AMERBAD=1 Q
  1.  ...S AMERDX=$P(Y,U,1),AMERNDX=$P(Y,U,2)
  1.  ...I ((AMERNDX=AMERODX)!(AMERNDX="")) Q
  1.  ...S AMERSTRG=$$EDAUDIT^AMEREDAU("5-01"_"."_AMEREDNO,$$EDDISPL^AMEREDAU(AMERODX,"X"),$$EDDISPL^AMEREDAU(AMERNDX,"X"),"DIAGNOSIS") ; Update the Audit file
  1.  ...I AMERSTRG="^" Q
  1.  ...S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERDXNO,DR=""
  1.  ...S DR=".01////"_AMERDX   ;IHS/OIT/SCR 11/07/08 try stuffing with no validation to get rid of weirdness
  1.  ...D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR) ; Update the POV multiple in AMER VISIT
  1.  ...I DA=1 D  ; UPDATE PRIM ICD IN ER VISIT FILE ; IHS/OIT/GIS 12/09/2011
  1.  ....S DIE="^AMERVSIT(",DA=AMERDA,DR="5.2////^S X=AMERDX"
  1.  ....L +^AMERVSIT(DA):1 I  D ^DIE L -^AMERVSIT(DA)
  1.  ....Q
  1.  ...S DR=""
  1.  ...Q
  1.  ..Q:AMERBAD!AMERQUIT
  1.  ..; User can change narrative
  1.  ..S DIR(0)="Y",DIR("A")="Do you want to change narrative",DIR("B")="YES"
  1.  ..D ^DIR K DIR
  1.  ..I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1
  1.  ..I $G(Y)=0 S AMERNNAR=AMERONAR
  1.  ..I $G(Y)=1 D
  1.  ...S DIR(0)="FAOr^1:80",DIR("A")="Enter NEW Provider Narrative: ",DIR("B")=AMERONAR
  1.  ...D ^DIR
  1.  ...I $D(DUOUT)!$D(DTOUT) S AMERQUIT=1 Q
  1.  ...Q:Y=""
  1.  ...;IHS/OIT/SCR 092909 patch 2 START CHANGES TO AVOID ";" IN NARRATIVE
  1.  ...D CKSC^AMER1
  1.  ...I $D(AMERCKSC) D
  1.  ....S AMERGOOD=0
  1.  ....F  Q:AMERGOOD  D
  1.  .....S Y=$G(DIR("B"))
  1.  .....S DIR(0)="FAOr^1:80",DIR("A")="Enter NEW Provider Narrative: ",DIR("B")=AMERONAR
  1.  .....D ^DIR
  1.  .....D CKSC^AMER1
  1.  .....I '$D(AMERCKSC) S AMERGOOD=1
  1.  .....K AMERCKSC
  1.  .....Q
  1.  ....I Y="" S AMERQUIT=1
  1.  ....Q
  1.  ...K DIR
  1.  ...Q:AMERQUIT
  1.  ...;IHS/OIT/SCR 071509 patch 2 END CHANGES
  1.  ...S AMERNNAR=Y
  1.  ...I (AMERNNAR'=AMERONAR) D
  1.  ....S DIE="^AMERVSIT(DA(1),5,",DA(1)=AMERDA,DA=AMERDXNO,DR=""
  1.  ....S AMERNNAR=$$STRIPNAR^AMERPCC2(AMERNNAR) ;IHS/OIT/SCR 05/05/09
  1.  ....S DR="1////"_AMERNNAR
  1.  ....D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR) K DIE ; Update the POV multiple in AMER VISIT
  1.  ....I DA=1 D  ; UPDATE PRIM DX NARR IN ER VISIT FILE ; IHS/OIT/GIS 12/09/2011
  1.  .....S DIE="^AMERVSIT(",DA=AMERDA,DR="5.3////^S X=AMERNNAR"
  1.  .....L +^AMERVSIT(DA):1 I  D ^DIE L -^AMERVSIT(DA)
  1.  .....Q
  1.  ....S DR=""
  1.  ....S AMERSTRG=$$EDAUDIT^AMEREDAU("5-1"_"."_AMEREDNO,AMERONAR,AMERNNAR,"PROVIDER NARRATIVE") ; Update the Audit file
  1.  ....I AMERSTRG="^" Q
  1.  ....S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ....Q
  1.  ...Q
  1.  ..I AMERNDX=AMERODX,AMERNNAR=AMERONAR ;IHS/OIT/GIS 11/30/11 patch 3
  1.  ..E  D UPVPOV^AMEREDDY(AMERNDX,AMERODX,AMERNNAR,AMERONAR,AMERDA) ; Update the V POV entry here
  1.  ..Q
  1.  .I AMEREDTS'="" D MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  .S AMEREDTS=""
  1.  .Q
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q AMERPRIS
  1.  S Y="",AMERDXNO=0
  1.  I 'AMERSKIP&(AMERDX>0) D
  1.  .S AMERODX="",AMERNDX=AMERICD9,AMEROLDS=""
  1.  .S AMERNDX=AMERICD9
  1.  .S DIR("A")="Enter narrative description of DX: "
  1.  .S DIR(0)="FAOr^1:80"
  1.  .S DIR("?")="Enter free text diagnosis (80 characters max.  ';' and ':' not allowed)"
  1.  .D ^DIR
  1.  .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q
  1.  .S AMERNNAR=Y
  1.  .Q:AMERNNAR=""
  1.  .S AMERNNAR=$$STRIPNAR^AMERPCC2(AMERNNAR) ;IHS/OIT/SCR 05/05/09
  1.  .I AMERDX=$P($$ICDDX^ICDCODE(".9999",,,1),U,1) D
  1.  ..S DA(1)=AMERDA,DIC="^AMERVSIT("_DA(1)_",5,",DIC(0)="L"  ; DIAGNOSES
  1.  ..S X=AMERDX
  1.  ..D FILE^DICN
  1.  ..Q
  1.  .I AMERDX'=$P($$ICDDX^ICDCODE(".9999",,,1),U,1) D
  1.  ..S DA(1)=AMERDA,DIC="^AMERVSIT("_DA(1)_",5,",DIC(0)="L" ; DIAGNOSES
  1.  ..S X="`"_AMERDX
  1.  ..D ^DIC
  1.  ..Q
  1.  .Q:Y<0
  1.  .; Just created a new DX in ER VISIT file - collect audit information and update V POV
  1.  .D ADDVPOV^AMEREDDY(AMERNDX,AMERNNAR,AMERDA) ; Add V POV entry to sync with ER VISIT file
  1.  .S AMERSTRG=$$EDAUDIT^AMEREDAU("5-01"_"."_AMEREDNO,"",$$EDDISPL^AMEREDAU(AMERNDX,"X"),"DIAGNOSIS") ; Collect code edit info
  1.  .I AMERSTRG="^" Q
  1.  .S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  .S DIE=DIC,DA(1)=AMERDA,DA=+Y,DR="1////"_AMERNNAR
  1.  .K DIC
  1.  .D MULTDIE^AMEREDIT(DIE,DA,DA(1),DR)
  1.  .Q
  1.  Q AMERPRIS
  1. SELECTDX(AMERPDX,AMERPNAR) ;IHS/OIT/GIS 9/9/11 patch 3
  1.  N AMERICD9,AMERDXNO,AMERSEL,DIR
  1.  S AMERSEL=0 ; DEFAULT TO QUIT
  1.  ;IHS/OIT/SCR 11/18/08 TEMPORARILY ALLOWING LOCAL CODES
  1.  ;S AMERICD9=$P($$ICDDX^ICDCODE($P($G(^AMERVSIT(AMERDA,5,0)),U,3),0),U,2)
  1.  ;S AMERICD9=$P($$ICDDX^ICDCODE($P($G(^AMERVSIT(AMERDA,5,0)),U,3),,,1),U,2)
  1.  D EN^DDIOL("EDIT/ADD Dx narrative(s) and/or code(s)","","!")
  1.  D EN^DDIOL("Primary DX is marked with '**'","","!?5")
  1.  ;IHS/OIT/SCR 11/03/08 - allow dx to be selected by number START CHANGES
  1.  S AMERDXNO=0
  1.  ; S DIR(0)="SO^0: ADD NEW DIAGNOSIS;"
  1.  S DIR(0)="SO^"
  1.  F  S AMERDXNO=$O(^AMERVSIT(AMERDA,5,AMERDXNO)) Q:(AMERDXNO="B"!(AMERDXNO=""))  D
  1.  .N Y1,Y2,Y
  1.  .S Y=$G(^AMERVSIT(AMERDA,5,AMERDXNO,0))  ;ICD9 CODE
  1.  . ;IHS/OIT/SCR 11/20/08 TEMPORARILY ALLOWING LOCAL CODES
  1.  .;S Y1=$P($$ICDDX^ICDCODE(Y),U,2)
  1.  .;S Y2=$P($$ICDDX^ICDCODE(Y),U,4)
  1.  .S Y1=$P($$ICDDX^ICDCODE(Y,,,1),U,2)
  1.  .S Y2=$P($$ICDDX^ICDCODE(Y,,,1),U,4)
  1.  .I Y1=AMERPDX&($G(^AMERVSIT(AMERDA,5,AMERDXNO,1))=AMERPNAR) D
  1.  ..S DIR(0)=DIR(0)_AMERDXNO_":**"_Y1_"("_Y2_") "_$G(^AMERVSIT(AMERDA,5,AMERDXNO,1))_";"
  1.  ..Q
  1.  .E  S DIR(0)=DIR(0)_AMERDXNO_":  "_Y1_"  ("_Y2_") "_$G(^AMERVSIT(AMERDA,5,AMERDXNO,1))_";"
  1.  .Q
  1.  S DIR(0)=DIR(0)_"A: ADD NEW DIAGNOSIS;Q: QUIT"
  1.  ; S DIR("B")=0 ;IHS/OIT/SCR 11/20/08
  1.  S DIR("A")="Enter line # to EDIT, 'A' to ADD NEW DIAGNOSIS, or 'Q' to QUIT",DIR("?")="Enter line number you want to edit, ADD or QUIT"
  1.  D ^DIR
  1.  I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q -1
  1.  Q $S(Y:Y,Y="A":0,1:-1)
  1.  ;