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

AMERPCC3.m

Go to the documentation of this file. 
  1. AMERPCC3 ; IHS/OIT/SCR - SUPPORTING ROUTINES FOR V POV SYNCHING ;
  1.  ;;3.0;ER VISIT SYSTEM;**1,2**;FEB 23, 2009
  1.  ;
  1. VPOVUPDT(AMERPAT,AMERPCC,AMERTIME,AMERDOC)  ;
  1.  ; For each ER DX, check to see if an entry has been made in V POV
  1.  ; - If entry has been made:
  1.  ;  -- Compare data and ask user to update if needed
  1.  ; - If entry has not been made
  1.  ;  --  ask user to add V POV entry or remove from ERS
  1.  ; For each V POV entry that is not matched to an ER DX, either add to ERS or remove from PCC
  1.  N AMERFND,AMERPOV,AMERVPOV,AMERVDR,AMERVIEN,AMERDX,AMERNAR,AMERVDXI,AMERVICD
  1.  N AMEREDNM,AMERDUZ,AMERAIEN,AMEREDTS,AMERCODE,AMERCNT,AMEREPOV,AMERENAR,AMER9999,AMERSLNT
  1.  N Y,X,DIC,DIE
  1.  N AMERCLN ;IHS/OIT/SCR 072309 patch 2
  1.  S AMERSLNT=0 ;IHS/OIT/SCR 060409 patch 1 
  1.  S AMEREDNM=0
  1.  S AMERVPOV=0
  1.  S AMERDUZ=DUZ
  1.  S AMEREDTS=""
  1.  S AMER9999=$P($$ICDDX^ICDCODE(".9999",,,1),U,1) ;POINTER TO .9999 CODE IN ICD9 CODE - THIS CODE CAN BE ENTERED MORE THAN ONCE
  1.   ; Now build array of the VALID ICD9 codes and narratives that exist in ER VISIT
  1.  I $G(^AMERVSIT(AMERDA,5,0))'="" D
  1.  .S AMERCNT=0
  1.  .;S AMEREPOV(1)=$P($$ICDDX^ICDCODE(+AMERPDX,,,1),U,1)  ;pointer to the primary ICD9 code
  1.  .;S AMERENAR(1)=AMERPNAR ; PRIMARY NARRATIVE
  1.  .S AMERPOV=0
  1.  .F  S AMERPOV=$O(^AMERVSIT(AMERDA,5,AMERPOV)) Q:AMERPOV="B"!(AMERPOV="")  D
  1.  ..S AMERCNT=AMERCNT+1
  1.  ..I $P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)=AMER9999 D
  1.  ...S AMERE999=AMERE999+1
  1.  ...;Q:((AMEREPOV(1)=AMER9999)&(AMERE999=1))
  1.  ...S AMERDX=AMER9999
  1.  ...S AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV  ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
  1.  ...S AMERENAR(AMERCNT)=$G(^AMERVSIT(AMERDA,5,AMERPOV,1))
  1.  ...Q
  1.  ..;E  I ($P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMERPDX) D
  1.  ..I $P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)'=AMER9999 D
  1.  ...S AMERCNT=AMERCNT+1
  1.  ...S AMERDX=$P($G(^AMERVSIT(AMERDA,5,AMERPOV,0)),U,1)
  1.  ...S AMEREPOV(AMERCNT)=AMERDX_"^"_AMERPOV  ; THIS IS A ICD9 POINTER WITH ITS INDEX IN THE ER VISIT FILE
  1.  ...S AMERENAR(AMERCNT)=$G(^AMERVSIT(AMERDA,5,AMERPOV,1))  ; DX NARATIVE
  1.  ...Q
  1.  ..Q  ;IF THIS ISN'T THE PRIMARY, ADD IT TO THE LIST OF DX'S TO ADD
  1.  .Q  ; FOR EACH ERS VISIT
  1.  S (AMERVDR,AMERVIEN)=""
  1.  ;IHS/OIT/SCR 072209 patch 2 - GET THE CLINIC THAT IS IN THE ER VISIT FILE
  1.  S AMERCLN=$P(^AMERVSIT(AMERDA,0),U,4)  ;this is a pointer to the ER OPTION FILE
  1.  ;S AMERCLN=$P($G(^AMER(3,AMERCLN,0)),U,4)  ; this is a clinic stop code
  1.  S:AMERCLN>0 AMERCLN=$P($G(^AMER(3,AMERCLN,0)),U,4)  ; IHS/OIT/SCR 10/05/09 patch 2
  1.  S AMERCODE=$S($G(AMERCLN)>0:$G(AMERCLN),1:80)
  1.  ;IHS/OIT/SCR 072309 if this code is not what is in V POV, update V POV to match
  1.  K APCLV
  1.  S AMERVERR=$$PCCVF^APCLV(AMERPCC,"POV","5;7;11;12;14;17")   ;bring back current V POV info
  1.  ; The V POV PRIMARY/SECODARY explainations in SAC Developers handbook state that the field is
  1.  ; Required for Hospitalizations.
  1.  ; For other visits, the first POV entered for a visit is considered the
  1.  ; primary one.
  1.  ; With this kind of business rule, we need to delete all V POV's and recreate
  1.  ; them when the "primary DX" in ERS is changed, and be sure the first one adeded is always the primary
  1.  S AMERPOV=0
  1.  I $O(APCLV(0))="" S AMERSLNT=1   ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
  1.  F  S AMERPOV=$O(AMEREPOV(AMERPOV)) Q:AMERPOV=""  D
  1.  .S AMERDX=$P(AMEREPOV(AMERPOV),"^",1)
  1.  .S AMERICD9=$P($$ICDDX^ICDCODE(AMERDX,,,1),U,2)
  1.  .S AMERINDX=$P(AMEREPOV(AMERPOV),"^",2)  ;DX INDEX IN ER VISIT FILE
  1.  .S AMERNAR=AMERENAR(AMERPOV)
  1.  .;I $O(APCLV(0))="" S AMERSLNT=1   ;IF THERE ARE NO PCC DX, JUST ADD ANY ERS WITHOUT ASKING
  1.  .S AMERFND=0,AMERVPOV=0  ; Flag set to 1 if DX CODE is later found in V POV file which should be looked at from the begining for each ER DX
  1.  .Q:AMEREPOV(AMERPOV)=""  ; If there is no valid DX CODE, quit
  1.  .F  S AMERVPOV=$O(APCLV(AMERVPOV)) Q:((AMERVPOV="")!AMERFND=1)  D
  1.  ..;IHS/OIT/SCR 02/05/09 START LOCAL CODE CHANFES
  1.  ..S AMERVICD=$P(APCLV(AMERVPOV),U,7)
  1.  ..S AMERVDXI=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)
  1.  ..I AMERVDXI<1 D
  1.  ...S AMERVDXI=$P($$ICDDX^ICDCODE(".9999",,,1),U,1)   ;start by setting it to 'uncoded'
  1.  ...I AMERVICD="VA LOCAL CODE SELECTED" D
  1.  ....;LOOK IT UP THROUGH FILEMAN
  1.  ....S DIC="^AUPNVPOV(",DIC(0)="NX",X="`"_$P(APCLV(AMERVPOV),"^",5)
  1.  ....D ^DIC
  1.  ....I (Y'=-1) D
  1.  .....S AMERVDXI=$P(Y,"^",2)   ;brings back the ICD ien
  1.  .....Q
  1.  ....Q  ;IF THIS WAS A LOCAL CODE
  1.  ...S AMERVICD=$P($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)  ;brings back the code
  1.  ...Q
  1.  ..;IHS/OIT/SCR 02/05/09 END LOCAL CODE CHANGES
  1.  ..I (AMERVICD=AMERICD9) D
  1.  ...S AMERFND=1
  1.  ...;IHS/OIT/SCR 072309 - update CLINIC STOP to match what is in ERS
  1.  ...D UPDTCLNC($P(APCLV(AMERVPOV),U,5),AMERCLN)
  1.  ...K APCLV(AMERVPOV)   ;REMOVE THIS ENTRY SINCE WE JUST MATCHED IT UP WITH AN ERS ENTRY
  1.  ...Q
  1.  ..Q  ;FOR EACH V POV ENTRY
  1.  .I AMERFND=0  D   ; Add this ER DIAGNOSIS TO THE PCC VISIT since it isn't there
  1.  ..I AMERSLNT S AMERANS=1  ;ADD ALL ERS ENTRIES TO V POV WITHOUT ASKING if there are no DX in PCC yet
  1.  ..E  D
  1.  ...D EN^DDIOL("**AN ERS DX CODE WAS NOT FOUND IN A V POV ENTRY FOR THIS PCC VISIT**","","!!?3")
  1.  ...;D EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
  1.  ...D EN^DDIOL("ERS DX CODE: "_AMERICD9_" - "_AMERNAR,"","!?3")
  1.  ...S DIR(0)="SO^1:ADD A NEW V POV ENTRY TO THIS PCC VISIT;2:REMOVE THE ERS DX CODE FROM THE ERS VISIT"
  1.  ...S DIR("A")="Which would you like to do"
  1.  ...D ^DIR K DIR
  1.  ...I (Y="^"!Y="") S AMERANS=2  ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY REMOVING THIS CODE
  1.  ...E  S AMERANS=+Y
  1.  ...Q
  1.  ..I (AMERANS=1) D
  1.  ...;ADD A V POV TO THIS PCC VISIT
  1.  ...I $P($G(^AMER(2.5,DUZ(2),0)),U,5)="N" S:AMERICD9'=".9999" AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE) Q
  1.  ...I $P($G(^AMER(2.5,DUZ(2),0)),U,5)'="N" S AMERVIEN=$$ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERPAT,AMERTIME,AMERDOC,AMERCODE)
  1.  ...I +AMERVIEN<1 D  Q   ; WRITE INFO TO SCREEN AND QUIT
  1.  ....D EN^DDIOL("UNABLE TO ADD PCC V POV "_AMERICD9,"","!!")
  1.  ....D EN^DDIOL("ERROR RETURNED : "_$P(AMERVIEN,U,2))
  1.  ....D:$P(AMERVIEN,U,2)="FAILED FM EDITS" EN^DDIOL("CONSIDER FINDING A MORE DETAILED CODE","","!!")
  1.  ....Q  ;IF ADD VPOV WAS NOT SUCCESSFUL
  1.  ...D EN^DDIOL("","","!")
  1.  ...D EN^DDIOL("** V POV ADDED TO PCC VISIT **","","!?3")
  1.  ...Q  ;I (AMERANS=1)
  1.  ..I (AMERANS=2) D
  1.  ...;REMOVE THE DX FROM THE ERS VISIT
  1.  ...D NOW^%DTC
  1.  ...;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0  ;CREATE AN AUDIT FILE RECORD
  1.  ...;S AMEREDNM=AMEREDNM+1
  1.  ...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERDX,"X")_";;Other;DIAGNOSIS;Silent PCC SYNCH"
  1.  ...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERONAR_";;Other;PROVIDER NARRATIVE;Silent PCC SYNCH"
  1.  ...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ...S DA(1)=AMERDA,DA=AMERINDX
  1.  ...S DIK="^AMERVSIT(DA(1),5,"
  1.  ...D ^DIK,EN^DIK  ; Delete identified entry and re-index diagnosis field
  1.  ...D EN^DDIOL("** DIAGNOSIS REMOVED FROM ERS VISIT **","","!?3")
  1.  ...Q  ;IF AMERANS=2 DELETE THE V POV ENTRY TO MATCH WHAT IS IN ERS
  1.  ..Q  ;IF ERS ENTRY WAS NOT FOUND IN V POV ARRAY
  1.  .Q  ;FOR EACH ERS ENTRY
  1.  ;IHS/OIT/SCR ...ANY V POV ENTRIES THAT ARE LEFT NEED TO BE REMOVED FROM PCC OR ADDED TO ERS
  1.  ;IF 'SILENT' ONLY ADD TO ERS
  1.  F  S AMERVPOV=$O(APCLV(AMERVPOV)) Q:AMERVPOV=""  D
  1.  .; APCLV(x)=^^^^internal value of V POV^^ ICD9 code^^^^Cause of injury^place of injury^provider narrative^date of injury
  1.  .S AMERVIEN=$P(APCLV(AMERVPOV),"^",1)
  1.  .S AMERVICD=$P(APCLV(AMERVPOV),"^",7)
  1.  .S AMERVNAR=$P(APCLV(AMERVPOV),"^",14)
  1.  .S AMERVDXI=$P($$ICDDX^ICDCODE(AMERVICD,,,1),U,1)
  1.  .I AMERVDXI<1 D
  1.  ..S AMERVDXI=$P($$ICDDX^ICDCODE(".9999",,,1),U,1)   ;start by setting it to 'uncoded'
  1.  ..I AMERVICD="VA LOCAL CODE SELECTED" D
  1.  ...;LOOK IT UP THROUGH FILEMAN
  1.  ...S DIC="^AUPNVPOV(",DIC(0)="NX",X="`"_$P(APCLV(AMERVPOV),"^",5)
  1.  ...D ^DIC
  1.  ...I Y'=-1 S AMERVDXI=$P(Y,"^",2)   ;brings back the ICD ien
  1.  ...Q
  1.  ..S AMERVICD=$P($$ICDDX^ICDCODE(AMERVDXI,,,1),U,2)  ;brings back the code
  1.  ..Q
  1.  .I AMERSLNT S AMERANS=2
  1.  .E  D
  1.  ..D EN^DDIOL("**A V POV ENTRY WAS FOUND THAT IS NOT CURRENTLY IN ERS FOR THIS VISIT**","","!!?3")
  1.  ..D EN^DDIOL("V POV ENTRY: "_AMERVICD_" - "_AMERVNAR,"","!?3")
  1.  ..;S DIR(0)="SO^1:ADD THIS DX INFORMATION TO THE ERS VISIT;2:REMOVE THE V POV ENTRY FROM THE PCC VISIT"
  1.  ..S DIR(0)="SO^1:REMOVE THE V POV ENTRY FROM THE PCC VISIT;2:ADD THIS DX INFORMATION TO THE ERS VISIT"
  1.  ..;S DIR("A")="Which would you like to do"
  1.  ..D ^DIR K DIR
  1.  ..I (Y="^"!Y="") S AMERANS=2  ;IF YOU CHOOSE NOT TO DECIDE,MAKE ERS MATCH PCC BY ADDING THIS CODE TO ERS
  1.  ..E  S AMERANS=+Y
  1.  ..Q
  1.  .I AMERANS=2 D
  1.  ..;ADD NEW DX TO ERS VISIT
  1.  ..;S:$G(AMERAIEN)="" AMERAIEN=$$CREATAUD^AMEREDAU(AMERDA,AMERDUZ) Q:AMERAIEN<0
  1.  ..S DA(1)=AMERDA,DIC="^AMERVSIT(DA(1),5,",DIC(0)="L" ; DIAGNOSES
  1.  ..S X="`"_AMERVDXI
  1.  ..D ^DIC
  1.  ..I +Y>0 D
  1.  ...;S AMEREDNM=AMEREDNM+1
  1.  ...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_$$EDDISPL^AMEREDAU(AMERNDXI,"X")_";;Other;DIAGNOSIS; PCC SYNCH"
  1.  ...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...;S AMERSTRG="5-01"_"."_AMEREDNM_";"_X_";"_AMERVNAR_";;Other;PROVIDER NARRATIVE; PCC SYNCH"
  1.  ...;S AMEREDTS=$S(AMEREDTS="":AMERSTRG,1:AMEREDTS_"^"_AMERSTRG)
  1.  ...;D:AMEREDTS'="" MULTAUDT^AMEREDAU(AMEREDTS,AMERAIEN)
  1.  ...D EN^DDIOL("** DIAGNOSIS ADDED TO ERS VISIT **","","!?3")
  1.  ...Q
  1.  ..Q
  1.  .I AMERANS=1 D
  1.  ..I $$REMOVPOV^AMERVSIT(AMERVIEN)  D EN^DDIOL("** V POV REMOVED FROM PCC VISIT **","","!?3")
  1.  ..E  D EN^DDIOL("** COULD NOT REMOVE V POV FROM PCC VISIT! **","","!?3")
  1.  ..Q
  1.  .Q
  1.  K APCLV
  1.  Q
  1. ADDPOV(AMERPCC,AMERICD9,AMERNAR,AMERDFN,AMERTIME,AMERDOC,AMERCLN)  ; ADD AN ENTRY TO V POV
  1.  ; AMERPCC - VISIT IEN
  1.  ; AMERICD9 - ICD9 CODE
  1.  ; AMERNAR -  PROVIDER NARRATIVE
  1.  ; AMERDFN  - PATIENT IEN
  1.  ; AMERTIME - VA FILE MAN FORMAT OF VISIT TIME
  1.  ; AMERDOC - POIINTER TO NEW PERSON PROVIDER
  1.  ; AMERCLN - IS NOT A POINTER TO ^DIC(40.2 - "CLINIC STOP" FILE - NO
  1.  ;           if I send through a pointer "72" - ^DIC(40.7,72,0)=URGENT CARE^80
  1.  ;           I see the clinic stop "MAMMOGRAPHY" ^DIC(40.7,67,0)=MAMMOGRAPHY^72
  1.  ;           SO   
  1.  ; AMERCLN - CLINC CODE:30 - EMERGENCY MEDICINE or 80 - URGENT CARE
  1.  K APCDALVR,APCDAFLE,APCDTPAT,APCDTPOV,APCDTNQ,APCDTPRO
  1.  I 'AMERPCC>0 Q 0  ; INVALID VISIT IEN
  1.  I 'AMERDFN>0 Q 0 ; INVALID PATIENT IEN
  1.  S APCDAFLE("APCDAFLE")="9000010.07"  ; THIS IS DOCUMENTED IN SAC Developer Handbook
  1.  S APCDALVR("APCDTPOV")=AMERICD9  ; ICD9 CODE -  pre-screened during "finalization"
  1.  S APCDALVR("APCDPAT")=AMERDFN  ; PATIENT IEN
  1.  S APCDALVR("APCDVSIT")=AMERPCC  ; VISIT IEN
  1.  S APCDALVR("APCDTNQ")=AMERNAR  ; NARRATIVE
  1.  S APCDALVR("APCDTCDT")=AMERTIME ; EVENT DATE AND TIME - date diagnosis
  1.  S APCDALVR("APCDTCLN")=AMERCLN   ; CLINIC - pointer to clinic stop file
  1.  S APCDALVR("APCDTEPR")="`"_AMERDOC   ; PROVIDER who made DIAGNOSIS - but in DD definition this is the encounter provider who treated the Dx...
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  D EN^APCDALVR
  1.  S AMERVIEN=$G(APCDALVR("APCDADFN"))
  1.  I AMERVIEN="" D
  1.   .S AMERVIEN=-1_"^"_$S($G(APCDALVR("APCDAFLG"))=1:"NO VISIT SELECTED",$G(APCDALVR("APCDAFLG"))=2:"FAILED FM EDITS",1:"UNSPECIFIFED ERROR")
  1.   D:+AMERVIEN>0 MOD^AUPNVSIT
  1.   K APCDALVR,APCDAFLE,APCDTPOV,APCDTPAT,APCDVSIT,APCDTNQ,APCDTCDT,APCDTCLN,APCDTEPR,APCDATMP
  1.  Q AMERVIEN
  1. UPDTCLNC(AMERVPOV,AMERCLN) ;update the CLINIC STOP field in V POV to match the value in ERS
  1.  ;IHS/OIT/SCR 090309 patch 2
  1.  N DIE,DA,DR
  1.  S DIE="^AUPNVPOV("
  1.  S DA=AMERVPOV
  1.  S DR="1203///"_AMERCLN
  1.  D ^DIE
  1.  Q