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