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

AMEREDDY.m

Go to the documentation of this file. 
  1. AMEREDDY ; IHS/OIT/SCR - Sub-routine for ER VISIT EDIT of DX information - Overflow from ^AMEREDDX
  1.  ;;3.0;ER VISIT SYSTEM;**3**;DEC 07, 2011;Build 11
  1.  ; SYNC V POV WITH UPDATED DX LIST IN ER VISIT FILE
  1.  ;  
  1. UPVPOV(AMERNDX,AMERODX,AMERNNAR,AMERONAR,AMERDA) ; If a secondary V POV record is edited, sync the corresponding V POV record
  1.  I $G(AMERNDX)'="",$G(AMERNNAR)'="",$G(AMERODX)'="",$G(AMERDA)
  1.  E  Q
  1.  N DIE,DIC,DA,DR,X,Y,Z,%,VIEN,IEN,CSIEN,NOW,STAT,PRVIEN,PS,DFN
  1.  S VIEN=$P($G(^AMERVSIT(AMERDA,0)),U,3) I 'VIEN Q
  1.  I AMERODX=.9999 S OIEN=$O(^ICD9("BA",".9999",0))
  1.  E  S OIEN=+$$CODEN^ICDCODE(AMERODX)
  1.  I OIEN<1 Q
  1.  I AMERNDX=.9999 S IIEN=$O(^ICD9("BA",".9999",0))
  1.  E  S IIEN=+$$CODEN^ICDCODE(AMERNDX)
  1.  I IIEN<1 Q
  1.  S IEN=0
  1.  F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN  I +$G(^AUPNVPOV(IEN,0))=OIEN Q
  1.  I 'IEN Q
  1.  S DR="",DA=IEN,DIE="^AUPNVPOV("
  1. EPX ; EP - UPDATE V POV PROPERTIES VIA DIE
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q
  1.  S CSIEN=$P($G(^AUPNVSIT(VIEN,0)),U,8)
  1.  S NOW=$$NOW^XLFDT
  1.  S PRVIEN=$P($G(^AMERVSIT(AMERDA,6)),U,3)
  1.  S PS="S"
  1.  S %=$P($G(^AMERVSIT(AMERDA,5.1)),U,2)
  1.  I %=OIEN S PS="P"
  1.  S DR=""
  1.  I AMERODX'="",AMERNDX'=AMERODX S DR=".01////^S X=IIEN"
  1.  I $D(^AUPNVPOV(DA)),$P(^AUPNVPOV(DA,0),U,2)="" D
  1.  . I DR'="" S DR=DR_";"
  1.  . S DR=DR_".02////^S X=DFN"
  1.  . Q
  1.  I $D(^AUPNVPOV(DA)),$P(^AUPNVPOV(DA,0),U,3)="" D
  1.  . I DR'="" S DR=DR_";"
  1.  . S DR=DR_".03////^S X=VIEN"
  1.  . Q
  1.  I AMERNNAR'=AMERONAR D
  1.  . S NIEN=$$NARR(AMERNNAR) I 'NIEN Q
  1.  . I DR'="" S DR=DR_";"
  1.  . S DR=DR_".04////^S X=NIEN"
  1.  . Q
  1.  I DR'="" S DR=DR_";"
  1.  S DR=DR_".12////^S X=PS;1201////^S X=NOW;1203////^S X=CSIEN;1204////^S X=PRVIEN;"
  1. EPY L +^AUPNVPOV(DA):1 I  D ^DIE L -^AUPNVPOV(DA)
  1.  Q
  1.  ; 
  1. NARR(X) ; RETURN THE IEN OF A PROVIDER NARRATIVE ENTRY - IF NECESSARY CREAT THE ENTRY
  1.  I $G(X)'=""
  1.  E  Q
  1.  N DIC,DLAYGO,Y
  1.  S (DIC,DLAYGO)=9999999.27,DIC(0)="LX"
  1.  D ^DIC I Y=-1 Q ""
  1.  Q +Y
  1.  ; 
  1. DELVPOV(AMERDA,DIEN) ; DELETE THE V POV ENTRY CORRESPONDING TO THE DELETED ER VISIT FILE DX THAT WILL BE DELETED
  1.  I $G(AMERDA),$G(DIEN)
  1.  E  Q
  1.  N DIK,DA,X,Y,Z,%,IIEN,VIEN,IEN,STOP,NIEN,NARR
  1.  S IIEN=+$G(^AMERVSIT(AMERDA,5,DIEN,0)) I 'IIEN Q
  1.  S VIEN=$P($G(^AMERVSIT(AMERDA,0)),U,3) I 'VIEN Q
  1.  S NARR=$G(^AMERVSIT(AMERDA,5,DIEN,1)) I NARR="" Q
  1.  S NIEN=$O(^AUTNPOV("B",NARR,0)) I 'NIEN Q
  1.  S DA=0,STOP=0
  1.  F  Q:STOP  S DA=$O(^AUPNVPOV("AD",VIEN,DA)) Q:'DA  D
  1.  . I +$G(^AUPNVPOV(DA,0))'=IIEN Q
  1.  . I $P($G(^AUPNVPOV(DA,0)),U,4)'=NIEN Q
  1.  . S STOP=1
  1.  . Q
  1.  I 'DA Q
  1.  S DIK="^AUPNVPOV("
  1.  D ^DIK
  1.  Q
  1.  ; 
  1. ADDVPOV(ICD,AMERNNAR,AMERDA) ; EP - ADD NEW V POV ENTRY CORRESPONDING TO NEW ER VISIT FILE DX
  1.  I $G(ICD)'="",$G(AMERNNAR)'="",$G(AMERDA)
  1.  E  Q
  1.  N X,Y,Z,%,DIC,DIE,DA,DR,DLAYGO,VIEN,IIEN,IEN,NIEN,DFN,OIEN
  1.  S VIEN=$P($G(^AMERVSIT(AMERDA,0)),U,3) I 'VIEN Q
  1.  I ICD=.9999 S IIEN=$O(^ICD9("BA",.9999,0))
  1.  E  S IIEN=+$$CODEN^ICDCODE(ICD) I 'IIEN Q
  1.  I IIEN<1 Q
  1.  S IEN=""
  1.  I ICD'=.9999 F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:'IEN  I +$G(^AUPNVPOV(IEN,0))=IIEN Q
  1.  I IEN Q  ; THE DX IS ALREADY IN THERE SO QUIT
  1.  S (DIC,DIE,DLAYGO)=9000010.07,DIC(0)="L"
  1.  S X="""`"_IIEN_""""
  1.  D ^DIC I Y=-1 Q
  1.  S OIEN=IIEN,DA=+Y
  1.  D EPX ;  ADD DX TO V POV
  1.  Q
  1.  ;