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

AMERVSIT.m

Go to the documentation of this file. 
AMERVSIT ; IHS/OIT/SCR - INTERFACING ROUTINES OUTSIDE OF AMER NAMESPACE REQUIRED FOR PCC VISIT CREATION

 ;;3.0;ER VISIT SYSTEM;**1,5**;MAR 03, 2009;Build 14

 ;

VPRVIEN(AMERPCC,AMERPIEN) ; EP from AMERPCC1

 ; ROUTINE to locate ien of V PROVIDER file in question 

 ; INPUT :

 ;   AMERPCC  - IEN OF PCC VISIT

 ;   AMERPIEN - PROVIDER IEN OF PROVIDER IN V PROVIDER FILE

 ;

 ; RETURNS IEN OF V PROVIDER FILE

 ;

 N AMERVIEN,AMERY,AMERFND,AMERVPRV

 S AMERVIEN=""

 S (AMERVPRV,AMERFND)=0

 F  S AMERVPRV=$O(^AUPNVPRV("AD",AMERPCC,AMERVPRV)) Q:(AMERVPRV=""!AMERFND)  D

 .; AMERVPRV is an IEN for a V PROVIDER entry for this visit.

 .; Now see if it is the V PROVIDER you were looking for

 .I AMERPIEN=$P($G(^AUPNVPRV(AMERVPRV,0)),U,1) D

 ..S AMERFND=1

 ..S AMERVIEN=AMERVPRV

 .Q

 Q AMERVIEN

 ;

VPOVIEN(AMERPCC,AMERPIEN) ;

 ; AMERPCC - IEN OF PCC VISIT

 ; AMERPIEN - ICD9 IEN OF ICD9 CODE IN V POV FILE

 ;

 ; RETURNS IEN OF V POV FILE

 ;

 N AMERVIEN,AMERY,AMERFND,AMERVPOV

 S AMERVIEN=""

 S (AMERVPOV,AMERFND)=0

 F  S AMERVPOV=$O(^AUPNVPOV("AD",AMERPCC,AMERVPOV)) Q:(AMERVPOV=""!AMERFND)  D

 .; AMERVPOV is an IEN for a V POV entry for this visit.

 .; Now see if it is the V POV you were looking for

 .I AMERPIEN=$P($G(^AUPNVPOV(AMERVPOV,0)),U,1) D

 ..S AMERFND=1

 ..S AMERVIEN=AMERVPOV

 .Q

 Q AMERVIEN

 ;

VSITDIE(AMERPCC,AMERVDR) ; EP from AMERPCC

 ; Updates VISIT file with AMERPCC IEN with DR string AMERVDR

 ; INPUT : 

 ;    AMERPCC - the VISIT ien for the entry that is being edited

 ;    AMERVDR - THE DR string that will be used to update this entry

 N DIE,DR

 S DR=AMERVDR

 S DIE="^AUPNVSIT(",DA=AMERPCC

 L +^AUPNVSIT(DA):2

 I $T D

 .D ^DIE

 .L -^AUPNVSIT(DA)

 .D MOD^AUPNVSIT

 .Q

 E  D EN^DDIOL("Unable to update VISIT file","","!!")

 Q

VPRVDIE(AMERVIEN,AMERVDR) ; EP from AMERPCC1

 ; Updates a particular V PROVIDER entry

 ; INPUT :

 ;   AMERVIEN - THE IEN OF THE V PROVIDER FILE THAT IS BEING MODIFIED

 ;   AMERVDR - THE DR STRING THAT PROVIDES INFORMATION TO BE USED

 N DIE,DR

 S DR=AMERVDR

 S DIE="^AUPNVPRV(",DA=AMERVIEN

 L +^AUPNVPRV(DA):2

 I $T D

 .D ^DIE

 .L -^AUPNVPRV(DA)

 .D MOD^AUPNVSIT  ; UPATE VISIT when modifying V PROVIDER

 .Q

 E  D EN^DDIOL("Unable to update V PROVIDER file","","!!")

 Q

VPOVDIE(AMERVIEN,AMERVDR) ; EP from AMERVSIT files to update V POV data

 ; Updates a particular V POV entry AMERVEIEN with DR string AMERVDR

 ; INPUT :

 ;   AMERVIEN : THE IEN OF THE V POV record to be updated

 ;   AMERVDR  : The DR string containing the field and value to be updated

 N DIE,DR

 S DR=AMERVDR

 S DIE="^AUPNVPOV(",DA=AMERVIEN

 L +^AUPNVPOV(DA):2

 I $T D

 .D ^DIE

 .L -^AUPNVPOV(DA)

 .D MOD^AUPNVSIT  ; UPATE VISIT when modifying V POV

 .Q

 E  D EN^DDIOL("Unable to update V POV file","","!!")

 Q

DELVPRV(AMERVPRV) ; EP from AMERPCC1

 ; REMOVE PROVIDER EIN AMERVPRV FROM V PROVIDER FILE

 ; INPUT: 

 ;   AMERVPRV : PROVIDER IEN TO BE REMOVED

 ;

 S DIK="^AUPNVPRV("

 S DA=AMERVPRV

 L +^AUPNVPRV(DA):2

 I $T D

 .D ^DIK

 .D IX^DIK  ; RE-INDEX FILE FOR THIS ENTRY

 .L -^AUPNVPRV(DA)

 .D MOD^AUPNVSIT

 E  D EN^DDIOL("Unable to delete from V PROVIDER entry","","!!")

 Q

DELETPRV(AMERPCC) ; EP

 ; DELETES ALL V PROVIDER ENTRIES FOR A GIVEN PCC VISIT 

 ; AMERPCC - VISIT IEN

 N AMERVPOV,DIK,DA

 S AMERVPRV=0

 I '$G(AMERPCC) Q 0

 L +^AUPNVPRV:3 E  Q

 F  S AMERVPRV=$O(^AUPNVPRV("AD",AMERPCC,AMERVPRV)) Q:AMERVPRV=""  D

 .S DA=AMERVPRV,DIK="^AUPNVPRV(" D ^DIK

 .D IX^DIK

 .Q

 L -^AUPNVPRV

 K DA,DIK

 Q 1

GETOPIEN(AMERNAME) ; EP from AMERPCC

 ; INPUT:

 ;   AMERNAME : the name of the option who's ien belongs in the "created by option" field of the VISIT file

 N AMEROIEN,DIC,X,Y

 S DIC="^DIC(19,"

 S DIC(0)="BO"  ; USE "B" CROSS REFERENCE AND ONLY FIND EXACT MATCH

 S X=AMERNAME

 D ^DIC

 I Y>0 S AMEROIEN=$P(Y,U,1)

 E  S AMEROIEN=-1

 Q AMEROIEN

GETVOPTN(AMERPCC) ; EP from AMERPCC

 ; RETURNS THE option used to create a visit

 ; INPUT :

 ;   AMERPCC : the IEN of the VISIT record in question

 N AMEROPT

 S AMEROPT=$P($G(^AUPNVSIT(AMERPCC,0)),U,24)

 Q AMEROPT

UPDTNAR(AMERVIEN,AMERNAR) ; EP from AMERPCC2

 ; UPDATES THE PROVIDER NARRATIVE FOR A GIVEN V POV ENTRY

 ; INPUT :

 ;   AMERVIEN - V POV IEN

 ;   AMERNAR  - PROVIDER NARRATIVE

 N AMERDR

 S AMERVDR=".04///"_AMERNAR

 D VPOVDIE(AMERVIEN,AMERVDR)

 Q

DELETPOV(AMERPCC) ; EP FROM AMERPCC2

 ; DELETES ALL V POV ENTRIES FOR A GIVEN PCC VISIT

 ; SO THEY CAN BE RE-ADDED WITH THE PRIMARY POV FIRST

 ;

 ; AMERPCC - VISIT IEN

 ;

 N AMERVPOV,DIK,DA

 S AMERVPOV=0

 I '$G(AMERPCC) Q 0

 L +^AUPNVPOV:3 E  Q

 F  S AMERVPOV=$O(^AUPNVPOV("AD",AMERPCC,AMERVPOV)) Q:AMERVPOV=""  D

 .S DA=AMERVPOV,DIK="^AUPNVPOV(" D ^DIK

 .Q

 L -^AUPNVPOV

 K DA,DIK

 Q 1

REMOVPOV(AMERVPOV) ; EP from AMERPCC2

 ; DELETES ONE V POV ENTRY

 ; INPUT:

 ;     AMERVPOV - V POV IEN TO BE DELETED

 N DIK,DA

 I '$G(AMERVPOV)>0 Q 0

 L +^AUPNVPOV:3 E  Q

 S DA=AMERVPOV

 S DIK="^AUPNVPOV("

 D ^DIK

 D IX^DIK  ; RE-INDEX FILE FOR THIS ENTRY

 L -^AUPNVPOV

 K DA,DIK

 Q 1

RTNGSLP(AMERDFN,AMERDATE) ; EP FROM AMERBSDU

 ; PRINTS ROUTING SLIP FOR A PATIENT WITH SCHEDULE

 ; INPUT:

 ;     AMERDFN - EIN OF PATIENT  IN PATIENT FILE

 ;     AMERDATE - DATE/TIME OF ER VISIT

 ;

 N SDX,SDSTART,ORDER,SDREP

 S DIR(0)="Y",DIR("A")="Do you want to PRINT a routing slip",DIR("B")="YES"

 D ^DIR

 Q:Y=0

 K IOP S (SDX,SDSTART,ORDER,SDREP)=""

 ;

 ;AMER*3.0*5

 D LOG^AMERBUSA("P","P","AMERREP3","AMER: Printed Routing Slip",AMERDFN)

 ; 

 D WISD^BSDROUT(AMERDFN,AMERDATE,"WI") ; lEGAL WITH PIMS 1006

 ; WISD^BSDROUT is not a public entry point yet but is in SOW for PIMS patch 1006.

 Q

NEWREG(AMERDFN,AMERDA) ; EP from AMEREDTA

 ; Called when a misidentified patient must be registered as a new patient

 ;

 ; AMERDFN - A PATIENT IEN

 ; AMERDA  - AN ER VISIT EIN

 ;

 ; RETURNS 1 IF PATIENT RECORD WAS CREATED ON DAY OF VISIT

 ;         0 IF PATIENT RECORD WAS NOT CREATED ON DAY OF VISIT

 N AMERCRTD,AMERVDAT,X1,X2,X,AMERNEW

 S AMERNEW=0

 S (AMERCRTD,X1)=$$DATECRTD(AMERDFN,"I")

 S (AMERVDAT,X2)=$P($G(^AMERVSIT(AMERDA,0)),U,1)

 D ^%DTC

 I X=0 S AMERNEW=1       ; THEN THE ORIGINAL PATIENT WAS CREATED ON THE DATE OF THE ER VISIT

 Q AMERNEW

DATECRTD(DFN,F) ;

 ; Returns DATE CREATED in F format

 ; F="E":DATE CREATED IN EXTERNAL FORMAT, F="I":DATE CREATED IN INTERNAL FORMAT

 N AMERIDAT,AMEREDAT

 S (AMERIDAT,AMEREDAT)=""

 I '$G(DFN) Q -1

 I '$D(^AUPNPAT(DFN,0)) Q -1

 S AMERIDAT=$P($G(^AUPNPAT(DFN,0)),"^",2)

 I AMERIDAT="" Q ""

 S F=$G(F)

 I F="E" D

 .S Y=AMERIDAT

 .D DD^%DT

 .S AMEREDAT=Y

 .Q

 Q $S(F="I":AMERIDAT,F="E":AMEREDAT,1:AMERIDAT)

CHANGPAT(AMERODFN,AMERDA,AMERISNW) ; EP FROM EDADMIT^AMEREDTA

 ; Updates appropriate files when a patient is changed in the editing interface

 ;  ALGORITHM:

 ;  1.  identifY if a new patient ID should be associated to the ER VISIT

 ; 2a. If NO updates use paitent reg APIs to change patient name

 ; 2b. If YES updates ER VISIT file and creates a new VISIT with new patient ID and old information

 ;     leaves old PCC VISIT with no V POV or V PROVIDER files and sends a mail

 ;       message idenifying original and changed information

 ; INPUT:

 ;      AMERODFN - THE ORIGINAL PATIENT DFN

 ;      AMERDA - POINTER TO THE ER VISIT FILE THAT IS BEING EDITED

 ; RETURNS;

 ;      AMERNDFN = THE NEW PATIENT DFN

 N AMERNDFN,AMERNPCC,AMEROPCC,AMERDONE

 N DIC,Y,DIR

 S AMERNDFN="",AMERDONE=0

 ; NOW SAVE OFF OLD INFORMATION

 S AMERDATE=$P($G(^AMERVSIT(AMERDA,0)),U,1)

 S AMEROPCC=$$FINDVSIT^AMERPCC(AMERDA)

 F  Q:AMERDONE=1  D

 .S DIC=2,DIC(0)="AEMQV"

 .S DIC("B")=$P($G(^DPT(AMERDFN,0)),U,1)

 .S DIC("A")="Enter the patient's NAME or LOCAL CHART NUMBER: "

 .D ^DIC K DIC,AUPNPAT,AUPNDOB,AUPNDOD,AUPNDAYS,AUPNSEX

 .I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT S AMERQUIT="",AMERNDFN=0,AMERDONE=1 Q

 .I +Y'=-1 S AMERNDFN=+Y

 .; IF THE PATIENT WAS ORIGINALLY CREATED FOR THIS VISIT, DON'T CREATE ANOTHER ONE

 .I (+Y=-1&AMERISNW) S AMERNDFN=0,AMERDONE=1 Q

 .I $P(Y,U,2)=$P($G(^DPT(AMERODFN,0)),U,1) D

 ..S DIR(0)="Y",DIR("A")="Do you want to register a new patient for this visit "

 ..S DIR("B")="NO"

 ..D ^DIR

 ..; Give user a chance to create a new patient if an existing patient was incorrectly identified

 ..I +Y=1 D

 ...S DOG="" K DFN D DOG^AG0

 ...S:$D(DFN) AMERNDFN=DFN

 ...Q

 ..Q

 .I AMERNDFN="" S AMERNDFN=AMERODFN Q  ; RETURN OLD PATIENT ID IF THE NEW PATIENT ID IS UNSUCCESSFUL

 .I AMERNDFN'=AMERODFN D

 ..S DIR(0)="Y",DIR("A")="Change patient from "_$P($G(^DPT(AMERODFN,0)),U,1)_" to "_$P($G(^DPT(AMERNDFN,0)),U,1)

 ..S DIR("B")="NO"

 ..D ^DIR

 ..I Y=0 S AMERNDFN=AMERODFN Q

 ..S AMERDONE=1   ; IF WE GOT THIS FAR, WE FOUND A PATIENT TO UPDATE SO QUIT LOOP

 ..; MODIFIY NEW VISIT CREATION TO WORK WITH SCHEDULED VISIT

 ..I $G(^AMER(2.5,DUZ(2),"SD"))="" S AMERNPCC=$$VISIT^AMERPCC(AMERNDFN,AMERDATE)

 ..; If the LOCATION is set up for scheduling create a PCC VISIT through ERS interface CHECKIN^AMERBSDU(AMERDFN,AMERTIME)

 ..I $G(^AMER(2.5,DUZ(2),"SD"))'="" S AMERNPCC=$$ERCHCKIN^AMERBSDU(AMERNDFN,AMERDATE)

 ..I AMERNPCC>0 D

 ...D SAVPCCO^AMERPCC(AMERNPCC,AMERDA) ; UPDATES ER VISIT FILE WITH NEW PCC IEN

 ...D DELETPRV(AMEROPCC)

 ...D DELETPOV(AMEROPCC)

 ...D SENDMSG(AMEROPCC,AMERNPCC,AMERODFN,AMERNDFN,AMERDATE)

 ...Q

 ..I AMERNPCC<1 D

 ...D EN^DDIOL("UNABLE TO CREATE NEW PCC VISIT FOR PATIENT "_AMERNDFN,"","!!")

 ...S AMERNDFN=AMERODFN

 ...Q

 ..Q

 .Q

 Q AMERNDFN

UPDATPAT(AMERDFN) ; EP FROM AMEREDTA  

 ; CALLED when a patient record that was created on the day of the ER VISIT is being updated

 ; INPUT:

 ;   AMERDFN : THE IEN OF THE PATIENT RECORD BEING EDITED

 ;

 N DFN,Y,AMERBAD,AMERAGN,AMERQUIT

 S (AMERQUIT,AMERAGN,AMERBAD)=0

 S DFN=AMERDFN

 F  Q:AMERQUIT=1  D

 .S AMERAGN=0

 .I $$NAME^AMERAGED(AMERDFN)=0 D  ; MODIFIED NAME^AGEMAN TO FORCE THIS DFN AND NO OTHER FOR EDIT

 ..S DIR("A")="There were problems with patient update, would you like to try again"

 ..S DIR(0)="Y",DIR("B")="YES"

 ..D ^DIR

 ..I Y=0 S (AMERQUIT,AMERBAD)=1

 ..I Y=1 S AMERAGN=1

 ..Q

 .Q:AMERBAD!AMERAGN

 .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q

 .D DOB^AG2A

 .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q

 .D SEX^AG2A

 .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q

 .D SSN^AG3A

 .I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT S AMERQUIT=1 Q

 .S AMERQUIT=1

 .Q

 I AMERBAD Q 0

 Q 1

SENDMSG(AMEROPCC,AMERNPCC,AMERODFN,AMERNDFN,AMERDATE) ;

 N AMERONAM,AMERNNAM,AMERMSG,X

 S AMERONAM=$P($G(^DPT(AMERODFN,0)),U,1)

 S AMERNNAM=$P($G(^DPT(AMERNDFN,0)),U,1)

 S Y=AMERDATE

 D DD^%DT

 S AMERDATE=Y

 S AMERMSG=$$PATMRG1^AMERXMB(AMERODFN,AMERONAM,AMEROPCC,AMERNDFN,AMERNNAM,AMERNPCC,AMERDATE)

 D EN^DDIOL("MESSAGE NUMBER "_AMERMSG_" CREATED AND SENT","","!!")

 Q

UPDTVTIM(AMERDA,AMEROTIM,AMERNTIM) ; EP from AMEREDTA

 ; Array APCDCVDT must be passed as follows:

 ;

 ;  APCDCVDT("VISIT DFN")=DFN of VISIT entry being changed.

 ;  APCDCVDT("VISIT DATE/TIME")=date and time to be changed to in

 ;                              internal FileMan form.

 ;  APCDCVDT("TALK")=any value including NULL

 N AMERDFN,AMERPCC

 K APCDCVDT

 S AMERDFN=$P($G(^AMERVSIT(AMERDA,0)),U,2)

 S AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)

 S APCDCVDT("VISIT DFN")=AMERPCC

 S APCDCVDT("VISIT DATE/TIME")=AMERNTIM

 S APCDCVDT("TALK")=""

 I AMERPCC<1 D EN^DDIOL("VISIT NOT FOUND - TIME NOT UPDATED","","!")

 D:AMERPCC>0 START^APCDCVDT

 I $D(APCDCVDT("ERROR FLAG")) D EN^DDIOL("ERRORS RETURNED AFTER UPDATING PCC VISIT TIME","","!!")

 K APCDCVDT

 Q

CLNICPTR(AMERPCC,AMERFORM) ;

 N AMERRTRN,AMERCLNC

 S AMERRTRN=""

 I 'AMERPCC Q -1

 I '$D(^AUPNVSIT(AMERPCC)) Q -1

 S AMERCLNC=$P(^AUPNVSIT(AMERPCC,0),U,8)

 I AMERCLNC=""

 I '$D(^DIC(40.7,AMERCLNC)) Q -1

 I AMERFORM="E" S AMERRTRN=$P(^DIC(40.7,AMERCLNC,0),U,1) ; THIS IS A WORD - EMERGENCY ROOM OR URGENT CARE

 S:AMERRTRN="" AMERRTRN=AMERCLNC

 Q AMERRTRN

 ;

UPDTVCLN(AMERVPOV,AMERVCLN) ; EP FROM AMERPCC2

 ; UPDATES THE "clinic" field of V POV to the one identified on the VISIT

 ; INPUT :

 ;     AMERVPOV - IEN OF VPOV BEING EDITED

 ;     AMERVCLN - THE NAME OF THE CLINIC STOP FILE THAT SHOULD BE ASSOCIATED TO THIS VPOV ENTRY

 N AMERVDR

 S AMERVDR=".08///"_AMERVCLN

 D VPOVDIE(AMERVPOV,AMERVDR)

 Q

GETPOVCL(AMERVPOV) ; EP from AMERPCC2

 ; INPUT:  AMERVPOV - IEN OF THE V POV FILE

 ; RETURNS: THE DESCRIPTION OF "CLINIC STOP"

 N AMERVCLN

 S AMERVCLN=$P($G(^AUPNVPOV(AMERVPOV,12)),U,3)  ; AMERVCLN IS A CODE -'30' FOR EMERGENCY '80' FOR URGENT CARE

 S:AMERVCLN'="" AMERVCLN=$P($G(^DIC(40.7,AMERVCLN,0)),U,1)  ; AMERVCLN IS A WORD

 Q AMERVCLN

GETPOVEP(AMERVPOV) ; EP from AMERPCC2

 ; INPUT AMERVPOV - IEN OF THE V POV FILE

 ; RETURNS - IEN OF ENCOUNTER PROVIDER FOR V POV ENTRY

 N AMEREPRV

 S AMEREPRV=$P($G(^AUPNVPOV(AMERVPOV,12)),U,4)

 Q AMEREPRV

UPDTEPRV(AMERVIEN,AMERDOC) ; EP FROM AMERPCC2

 ; Updates ENCOUNTER PROVIDER in V POV file

 ; INPUT

 ;  AMERVIEN : THE IEN of the V POV entr being updated

 ;  AMERDOC  : The IEN of the NEW PERSON with provider keys being added to file

 ;             note: the four slash stuff is needed to avoid cross-referencing that can identify a provider by last four of social security

 N AMERVDR

 S AMERVDR="1204////"_AMERDOC

 D VPOVDIE(AMERVIEN,AMERVDR)

 Q

DELETVST(AMERDA) ; IHS/OIT/SCR 10/08/08 - DELETE PCC VISIT WHEN 'REGISTERED IN ERROR'

 ; CALLED WHEN A VISIT IS SAVED WITH DISPOSITION 'REGISTERED IN ERROR'

 ; Updates VISIT file with AMERPCC IEN with DR string AMERVDR

 ; INPUT : 

 ;    AMERPCC - the VISIT ien for the entry that is being DELETED

 N APCDVDLT,AMERPCC,DIK,DA,AMERDFN,AMERTIME

 S AMERPCC=$$FINDVSIT^AMERPCC(AMERDA)

 I AMERPCC>0 D

 .S APCDVDLT=AMERPCC

 .D EN^APCDVDLT

 .K APCDVDLT

 S DIK="^AMERVSIT(",DA=AMERDA

 D ^DIK

 S AMERTIME=$P($G(^AMERVSIT(AMERDA,0)),U,1)

 S AMERDFN=$P($G(^AMERVSIT(AMERDA,0)),U,2)

 ;IHS/OIT/SCR 10/27/08

 D CANCEL^AMERBSDU(AMERDFN,AMERTIME)

 Q