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

AMER31.m

Go to the documentation of this file. 
  1. AMER31 ; IHS/ANMC/GIS -ISC - ENTER DIAGNOSES ;  
  1.  ;;3.0;ER VISIT SYSTEM;**6,7,8**;MAR 03, 2009;Build 23
  1.  ;
  1. QD11 ; ENTRY POINT FROM AMER3
  1.  ;
  1.  NEW PVCNT,DLAYGO,AMERDUZ,AMERPOV,AMERIEN,AMERNCHK
  1.  NEW APCDCAT,APCDVSIT,APCDPAT,APCDLOC,APCDTYPE,APCDMODE,APCDPARM
  1.  NEW APCDMNE,APCDVLDT,APCDVLK,DIC,AMERPCC,VDT,ICD10,DIDEL,AMERPOV
  1.  ;
  1.  ;Make sure variables are set up properly to allow adds/deletes
  1.  S (DLAYGO,DIDEL)=9000010.07
  1.  I $G(DUZ("AG"))="I" S AMERDUZ=DUZ(0),DUZ(0)="@"
  1.  ;
  1. QD11E ;Get the visit IEN
  1.  S AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I") I AMERPCC="" G QD11X
  1.  S VDT=$P($$GET1^DIQ(9000010,AMERPCC,.01,"I"),".")
  1.  ;
  1.  ;Determine if ICD-10 has been implemented
  1.  S ICD10=0 I $$VERSION^XPDUTL("AICD")>3.51,$$IMP^ICDEXA(30)'>VDT S ICD10=1
  1.  ;
  1.  ;AMER*3.0*6;Display any POV information already on file
  1.  S AMERPOV="" F PVCNT=1:1 S AMERPOV=$O(^AUPNVPOV("AD",AMERPCC,AMERPOV)) Q:AMERPOV=""  D
  1.  . NEW ICDIEN,INFO,PS,PNARR
  1.  . I PVCNT=1 D
  1.  .. W $$S^AMERUTIL("RVN")
  1.  .. W !!,"Current Purpose of Visit entries on file for this visit:",!
  1.  .. W $$S^AMERUTIL("RVF")
  1.  . ;
  1.  . ;Display each entry
  1.  . S ICDIEN=$$GET1^DIQ(9000010.07,AMERPOV,.01,"I")
  1.  . S PS=$$GET1^DIQ(9000010.07,AMERPOV,.12,"I")
  1.  . S INFO=$$ICDDX^AUPNVUTL(ICDIEN,VDT)
  1.  . S PNARR=$$VAL^XBDIQ1(9000010.07,AMERPOV,.04)
  1.  . W !,"Code: ",$P(INFO,U,2),?15,"P/S: ",PS,?23,"Description: ",$E($P(INFO,U,4),1,55)
  1.  . I PNARR="" W $$S^AMERUTIL("RVN")
  1.  . W !?3,"Prov Narrative: ",PNARR
  1.  . I PNARR="" W $$S^AMERUTIL("RVF")
  1.  ;
  1.  ;Prompt for Edits
  1.  S X=$G(X)
  1.  I PVCNT>1 D  Q:X]""
  1.  . ;
  1.  . NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . S DIR(0)="Y",DIR("B")="NO"
  1.  . S DIR("A")="Edit Existing Purpose of Visit Information"
  1.  . W !
  1.  . D ^DIR
  1.  . I $G(DTOUT)!$G(DUOUT)!$G(DIRUT)!$G(DIROUT) S X="^" Q
  1.  . S X=$S(Y=1:"",Y=0:"",1:X)
  1.  . I Y'=1 Q
  1.  . ;
  1.  . ;Perform Purpose of Visit Edit
  1.  . W $$S^AMERUTIL("RVN")
  1.  . W !!,"Select the Purpose of Visit Entry to Edit"
  1.  . W $$S^AMERUTIL("RVF")
  1.  . S X=$$AEPOV(AMERPCC,DFN,"M")
  1.  ;
  1.  ;Perform POV adds
  1.  I PVCNT>1 W !!,"*Enter Additional Purpose of Visit Information"
  1.  E  W !!,"*Enter Purpose of Visit Information"
  1.  W !,"   Enter ",$$S^AMERUTIL("RVN"),$S(ICD10:"ZZZ.999",1:".9999"),$$S^AMERUTIL("RVF")," to log an uncoded diagnosis"
  1.  S X=$$AEPOV(AMERPCC,DFN,"A")
  1.  ;
  1.  ;Make sure a POV entry was logged
  1.  S AMERPOV=$$POV^AMERUTIL("",AMERPCC,.AMERPOV)
  1.  I ($P(AMERPOV,U)<1) D  G QD11E:X="",QD11X:X]""
  1.  . NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . W !!,"This answer is mandatory."
  1.  . S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
  1.  . S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
  1.  . W !
  1.  . D ^DIR
  1.  . I Y'="E" S X="^",Y="^" Q
  1.  . S X=""
  1.  ;
  1.  ;Make sure a primary POV entry was logged
  1.  I ($P(AMERPOV,U,2)<1) D  G QD11E:X="",QD11X:X]""
  1.  . NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . W !!,"A primary Purpose of Visit is required."
  1.  . S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
  1.  . S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
  1.  . W !
  1.  . D ^DIR
  1.  . I Y'="E" S X="^" Q
  1.  . S X=""
  1.  ;
  1.  ;Make sure only one primary POV entry was logged
  1.  I ($P(AMERPOV,U,2)>1) D  G QD11E:X="",QD11X:X]""
  1.  . NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . W !!,"Only one primary POV is permitted."
  1.  . S DIR(0)="SA^E:Enter POV now;P:Step to previous prompt",DIR("B")="E"
  1.  . S DIR("A")="(E)nter Purpose of Visit now or return to (P)revious prompt: "
  1.  . W !
  1.  . D ^DIR
  1.  . I Y'="E" S X="^" Q
  1.  . S X=""
  1.  ;
  1.  ;AMER*3.0*8;Validate provider narrative
  1.  S (AMERNCHK,AMERIEN)="" F  S AMERIEN=$O(AMERPOV(AMERIEN)) Q:AMERIEN=""  D  Q:+AMERNCHK
  1.  . NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1.  . I $P(AMERPOV(AMERIEN),U,3)]"" Q
  1.  . S AMERNCHK="1"
  1.  . W $$S^AMERUTIL("RVN")
  1.  . W !!,"**POV ",$P(AMERPOV(AMERIEN),U)," is missing a required PROVIDER NARRATIVE entry**",!
  1.  . W $$S^AMERUTIL("RVF")
  1.  I +AMERNCHK G QD11E
  1.  ;
  1.  ;Handle Injury Matching
  1.  D INJURY(.AMERPOV,.X) I $G(X)="^" G QD11E
  1.  ;
  1.  ;Set DUZ(0) back to original value
  1.  I $G(DUZ("AG"))="I" S DUZ(0)=$G(AMERDUZ)
  1.  ;
  1.  ;BEE;Fix for endless loop issue
  1.  S Y=1
  1.  ;  
  1. QD11X S:$G(AMERDUZ)]"" DUZ(0)=AMERDUZ
  1.  Q
  1.  ;
  1. AEPOV(AMERPCC,DFN,APCDMODE) ;EP - Add/Edit POV information
  1.  NEW APCDCAT,APCDVSIT,APCDVLK,APCDPAT
  1.  NEW APCDPARM,APCDDATE,APCDVLDT,APCDLOC,APCDTYPE
  1.  NEW DIC,X,Y,DTOUT,DUOUT,APCDMNE,AMERGBL
  1.  ;
  1.  ;Verify that DUZ was passed in and set up
  1.  D DUZ^XUP(DUZ)
  1.  ;
  1.  S APCDCAT="H",(APCDVSIT,APCDVLK)=AMERPCC,APCDPAT=DFN
  1.  S APCDPARM=$G(^APCDSITE(DUZ(2),0))
  1.  S (APCDDATE,APCDVLDT)=$$GET1^DIQ(9000010,AMERPCC,.01,"I")
  1.  S APCDLOC=DUZ(2),APCDTYPE=$$GET1^DIQ(9000010,AMERPCC,.03,"I")
  1.  ;
  1.  ;Get the IEN for the 'PV' mnemonic
  1.  S DIC=9001001,DIC(0)="",X="PV" D ^DIC
  1.  I Y<1 Q "^"
  1.  S APCDMNE=+Y,APCDMNE("NAME")=$P(Y,U,2)
  1.  S AMERGBL="^AUPNVPOV"
  1.  S Y=AMERGBL_"(""AD"","_AMERPCC_",0)" I '$O(@Y) S APCDMODE="A"
  1.  ;
  1.  ;Perform POV edit/entry
  1.  D ^APCDEA3
  1.  Q ""
  1.  ;
  1. INJURY(AMERPOV,X) ;Match Injury with V POV and update V POV record
  1.  ;
  1.  NEW POVCNT,VPOVIEN,CNT,Y,DTOUT,DUOUT,DIRUT,DIROUT,VAL,POVLST
  1.  ;
  1.  ;If no injury quit
  1.  I '+$G(^TMP("AMER",$J,2,2)) Q
  1.  ;
  1.  ;Get the number of V POV entries
  1.  S POVCNT=+$G(AMERPOV) Q:'POVCNT
  1.  ;
  1.  ;If only one V POV entry map to that one automatically
  1.  I POVCNT=1 D  Q
  1.  . S VPOVIEN=$P($G(AMERPOV(1)),U,6) Q:VPOVIEN=""
  1.  . D UPDPOV(VPOVIEN)
  1.  ;
  1.  ;If more than one V POV entry, allow user to select entry or entries to map to
  1.  W $$S^AMERUTIL("RVN")
  1.  W !!,"Current POV information on file:"
  1.  W $$S^AMERUTIL("RVF")
  1.  W !!,"# ",?3,"P/S",?7,"Code",?18,"Description",?50,"Provider Narrative"
  1.  F CNT=1:1:POVCNT D
  1.  . Q:'$D(AMERPOV(CNT))
  1.  . W !,CNT,?3,$P(AMERPOV(CNT),U,2),?7,$P(AMERPOV(CNT),U),?18,$E($P(AMERPOV(CNT),U,5),1,30),?50,$E($P(AMERPOV(CNT),U,3),1,29)
  1.  ;
  1.  ;Prompt user for which one(s) to match injury to
  1.  S DIR(0)="L^1:"_POVCNT
  1.  S DIR("A")="Select the POV entry or entries to match the injury information to"
  1.  W !
  1.  D ^DIR
  1.  I $D(DIRUT) S X="^" Q
  1.  S POVLST=Y
  1.  ;
  1.  ;Match selected entry or entries to the injury information
  1.  F CNT=1:1:$L(POVLST,",") S VAL=$P(POVLST,",",CNT) I +VAL D
  1.  . Q:'$D(AMERPOV(+VAL))
  1.  . S VPOVIEN=$P($G(AMERPOV(+VAL)),U,6) Q:VPOVIEN=""
  1.  . D UPDPOV(VPOVIEN)
  1.  ;
  1.  Q
  1.  ;
  1. UPDPOV(VPOVIEN) ;Update V POV entry with Injury Information
  1.  ;
  1.  NEW VPOVUPD,ERROR,INJDT,INJCS,INJPL,INJCVPL,%,AUPNVSIT
  1.  ;
  1.  ;Quit if no V POV IEN
  1.  I $G(VPOVIEN)="" Q
  1.  ;
  1.  ;Get the visit IEN
  1.  S AUPNVSIT=$$GET1^DIQ(9000010.07,VPOVIEN_",",.03,"I")
  1.  ;
  1.  ;Pull Injury Date
  1.  S INJDT=$P($G(^TMP("AMER",$J,2,32)),".")
  1.  ;
  1.  ;Pull Injury Cause
  1.  S INJCS=$G(^TMP("AMER",$J,2,33))
  1.  ;I INJCS]"" S INJCS=$$GET1^DIQ(9009083,INJCS_",",7,"I")
  1.  ;
  1.  ;Place of Accident - Convert
  1.  S INJPL=$G(^TMP("AMER",$J,2,34))
  1.  I INJPL]"" S INJPL=$$GET1^DIQ(9009083,INJPL_",",.01,"E")
  1.  ;
  1.  ;Valid PCC values
  1.  ;A:HOME-INSIDE;B:HOME-OUTSIDE;C:FARM;D:SCHOOL;E:INDUSTRIAL PREMISES;F:RECREATIONAL AREA;
  1.  ;G:STREET/HIGHWAY;H:PUBLIC BUILDING;I:RESIDENT INSTITUTION;J:HUNTING/FISHING;K:OTHER;L:UNKNOWN
  1.  S INJCVPL="L"
  1.  I INJPL["HIGHWAY" S INJCVPL="G"
  1.  E  I INJPL["HOME" S INJCVPL="A"
  1.  E  I INJPL["INDUSTRIAL" S INJCVPL="E"
  1.  E  I INJPL["MINE" S INJCVPL="K"
  1.  E  I INJPL["OTHER" S INJCVPL="K"
  1.  E  I INJPL["PUBLIC" S INJCVPL="H"
  1.  E  I INJPL["FARM" S INJCVPL="C"
  1.  E  I INJPL["RECREATION" S INJCVPL="F"
  1.  E  I INJPL["RESIDENT" S INJCVPL="I"
  1.  E  I INJPL["UNSPECIFIED" S INJCVPL="L"
  1.  E  I INJPL["SCHOOL" S INJCVPL="D"
  1.  E  I INJPL["HUNTING" S INJCVPL="J"
  1.  E  I INJPL["FISHING" S INJCVPL="J"
  1.  ;
  1.  ;Save the injury date in the V POV entry
  1.  D NOW^%DTC
  1.  S VPOVUPD(9000010.07,VPOVIEN_",",.09)=INJCS
  1.  S VPOVUPD(9000010.07,VPOVIEN_",",.11)=INJCVPL
  1.  S VPOVUPD(9000010.07,VPOVIEN_",",.13)=INJDT
  1.  S VPOVUPD(9000010.07,VPOVIEN_",",1218)=%
  1.  S VPOVUPD(9000010.07,VPOVIEN_",",1219)=DUZ
  1.  D FILE^DIE("","VPOVUPD","ERROR")
  1.  ;
  1.  ;Mark that the visit was modified
  1.  D MOD^AUPNVSIT
  1.  ;
  1.  Q