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

MPIFAPI.m

Go to the documentation of this file.
  1. MPIFAPI ;CMC/BP-APIS FOR MPI ;DEC 21, 1998
  1. ;;1.0;MASTER PATIENT INDEX VISTA;**1,3,14,16,17,21,27,28,33,35,37,43,45,44,46,48,55,56,60,61,62**;30 Apr 99;Build 3
  1. ; Integration Agreements Utilized:
  1. ; ^DPT( - #2070 and #4079
  1. ; ^DPT("AICN", ^DPT("AMPIMIS", ^DPT("ASCN2" - #2070
  1. ; EXC, START, STOP^RGHLLOG - #2796
  1. ;
  1. EN2() ;NEW ENTRY POINT FOR LOCALS
  1. N MPIOUT,DIC,MPICHK,MPINCK,MPINNM,MPINUM1,DA,MPINUM
  1. I $O(^MPIF(984.1,0))="" G SETUP
  1. AGN2 L +^MPIF(984.1):1 E H 3 G AGN2
  1. S MPINUM=0,X=$$SITE^VASITE,X=$P(X,"^",3),X=X\1
  1. S DIC="^MPIF(984.1,",DIC(0)="XZ" D ^DIC
  1. S MPINUM1=$P(Y(0),"^",4),MPICHK=$P(Y(0),"^",5),MPINNM=MPINUM1+1
  1. S MPINUM=MPINUM1_"V"_MPICHK,MPINCK=$$CHECKDG^MPIFSPC(MPINNM)
  1. S DA=1,DIE="^MPIF(984.1,",DR="1////^S X=MPINUM1;2////^S X=MPICHK;3////^S X=MPINNM;5////"_MPINCK
  1. D ^DIE
  1. K DIE,DR,X,Y
  1. L -^MPIF(984.1)
  1. Q MPINUM
  1. SETUP ;
  1. N CHK,NUM,NXTCHK,NXTNUM,SITE,DA
  1. S SITE=$$SITE^VASITE,SITE=$P(SITE,"^",3),SITE=SITE\1
  1. S DIC="^MPIF(984.1,",DA=1,DIC(0)="",X=SITE
  1. S NUM=SITE_"0000000",CHK=$$CHECKDG^MPIFSPC(NUM),MPINUM=NUM_"V"_CHK
  1. S NXTNUM=NUM+1,NXTCHK=$$CHECKDG^MPIFSPC(NXTNUM)
  1. S DIC("DR")="1////^S X=NUM;2////^S X=CHK;3////^S X=NXTNUM;5////"_NXTCHK
  1. K DD,D0
  1. D FILE^DICN
  1. K DIC,X,Y
  1. Q MPINUM
  1. ;
  1. N MPIL,MPILINK
  1. D LINK^HLUTIL3("MPI",.MPIL)
  1. I '$D(MPIL) Q "-1^NOT DEFINED"
  1. S MPILINK=$O(MPIL(0))
  1. I MPILINK="" Q "-1^NOT DEFINED"
  1. S MPILINK=$G(MPIL(MPILINK))
  1. Q MPILINK
  1. ;
  1. SUBNUM(DFN) ; returns SCN from MPI node for given DFN
  1. ; DFN - ien of patient file
  1. ; returns: -1^error message << always returns.
  1. ;*** Subscription control numbers no longer exist
  1. Q "-1^No Subscription Control Number for DFN "_DFN
  1. ;
  1. MPINODE(DFN) ; returns MPI node for given DFN
  1. ; DFN - patient file ien
  1. ; returns: -1^error message or MPI node from patient file
  1. N TMP
  1. I '$D(DFN) Q "-1^DFN not defined"
  1. I '$D(^DPT(DFN)) Q "-1^DFN doesn't exist"
  1. I '$D(^DPT(DFN,"MPI")) Q "-1^No MPI node for DFN "_DFN
  1. L +^DPT("MPI",DFN):10 ;**45 added lock check for getting ICN data back
  1. N NODE S NODE=$G(^DPT(DFN,"MPI"))
  1. I NODE=""!(NODE?."^") S NODE="-1^No MPI data for DFN "_DFN
  1. I +NODE>0 D
  1. .;**45 checking if checksum for ICN is correct, if not update the 991.02 field
  1. .; and include new value in NODE returned.
  1. .N CHK S CHK=$$CHECKDG^MPIFSPC($P(NODE,"^"))
  1. .I CHK'=$P(NODE,"^",2) S TMP=$$SETICN^MPIF001(DFN,$P(NODE,"^"),CHK) S $P(NODE,"^",2)=CHK
  1. L -^DPT("MPI",DFN)
  1. Q NODE
  1. ;
  1. GETADFN(ICN) ; return DFN ONLY if ICN is the active ICN
  1. ; ICN - Integration Control Number for patient to be returned
  1. ; returns: -1^error message
  1. ; DFN - IEN for the patient entry in the Patient file (#2)
  1. N RETURN,DFN
  1. I $G(ICN)'>0 Q "-1^NO ICN"
  1. I '$D(^DPT("AICN",ICN)) Q "-1^ICN NOT IN DATABASE"
  1. S DFN=$O(^DPT("AICN",ICN,0))
  1. I $G(DFN)'>0 Q "-1^BAD AICN CROSS-REFERENCE"
  1. I $P($G(^DPT(DFN,"MPI")),"^")'=ICN Q "-1^ICN is not Active one"
  1. Q DFN
  1. ;
  1. AICN2DFN(ICN) ; return DFN ONLY if Full ICN is the active ICN
  1. ;**60 (elz) MVI_793 create APIs for Full ICN field
  1. ; ICN - Integration Control Number for patient to be returned (FULL)
  1. ; returns: -1^error message
  1. ; DFN - IEN for the patient entry in the Patient file (#2)
  1. N RETURN,DFN
  1. I $G(ICN)'>0 Q "-1^NO ICN"
  1. I ICN'["V" Q "-1^Full ICN required"
  1. I '$D(^DPT("AFICN",ICN)) Q "-1^ICN NOT IN DATABASE"
  1. S DFN=$O(^DPT("AFICN",ICN,0))
  1. I $G(DFN)'>0 Q "-1^BAD AFICN CROSS-REFERENCE"
  1. I $P($G(^DPT(DFN,"MPI")),"^",10)'=ICN Q "-1^ICN is not Active one"
  1. Q DFN
  1. ;
  1. UPDATE(DFN,ARR,MPISILNT,REMOVE) ;api to edit 'mpi','mpifhis' and 'mpicmor' nodes
  1. ;**37 UPDATE module moved 3/30/05 from MPIFAPI into MPIFAPI1.
  1. ;Linetag must remain due to DBIA #2706.
  1. Q $$UPDATE^MPIFAPI1(DFN,ARR,.MPISILNT,.REMOVE)
  1. ;
  1. MPIQ(DFN) ;MPI QUERY
  1. N MPIFARR
  1. L +^DPT(DFN):2 I '$T,'$D(MPIFS) W $C(7),!!,"Patient is being edited. No attempt will be made to connect to the MPI." H 2 Q
  1. I '$D(MPIFS) D ;Not from SmartCard background job
  1. .;**37 mods to L -^DPT
  1. .I $G(DGNEW)=1 D ;New patient, fields always blank, ask
  1. ..D WRTLN
  1. ..; **44 Adding Pseudo SSN Reason to the list of prompted fields if SSN is a pseudo and there isn't already a reason stored
  1. ..N MPIFP S MPIFP="" S DA=DFN,DIQ(0)="EI",DIC=2,DR=".09;.0906",DIQ="MPIFARR" D EN^DIQ1 K DA,DR,DIC,DQ,DR
  1. ..I $D(MPIFARR(2,DFN,.0906,"I")) D
  1. ...I MPIFARR(2,DFN,.09,"E")["P",("S"[MPIFARR(2,DFN,.0906,"I")) S MPIFP=".0906;"
  1. ..S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
  1. ..S DR=MPIFP_".2403;.092;.093;1",DR(2,2.01)=".01;1" D ^DIE K DA,DIE,DR Q ;*55 MPIC_1402 ALIAS SSN
  1. .I $G(DGNEW)="" D ;Existing patient, get current values
  1. ..N MPIDOB,IMPRS,MPIMMN,MPICTY,MPIST
  1. ..S DIC=2,DR=".02;.03;.09;.0906;.092;.093;.2403;994;1",DR(2.01)=".01"
  1. ..;^ **44 include pseudo ssn reason to list
  1. ..S DA=DFN,DA(2.01)=1,DIQ(0)="EI",DIQ="MPIFARR"
  1. ..D EN^DIQ1 K DA,DIC,DIQ,DR
  1. ..;build DR from blank fields / imprecise DOB / pseudo SSN
  1. ..S DR=""
  1. ..S MPIDOB=$G(MPIFARR(2,DFN,.03,"I")) ;DATE OF BIRTH
  1. ..I MPIDOB="" S DR=DR_".03;" ;DOB null
  1. ..;Is DOB imprecise?
  1. ..I MPIDOB'="" S IMPRS=0 D
  1. ...I $E(MPIDOB,4,7)="0000" S IMPRS=1 ;Year only; no month/day
  1. ...I ($E(MPIDOB,6,7)="00")&($E(MPIDOB,4,5)'="00") S IMPRS=1 ;Year/month only; no day
  1. ...I IMPRS=1 S DR=DR_".03;" ;DOB imprecise
  1. ..I $G(MPIFARR(2,DFN,.02,"I"))="" S DR=DR_".02;" ;SEX
  1. ..;if the SSN is null, add to prompted fields
  1. ..N SSNP S SSNP=0
  1. ..I ($G(MPIFARR(2,DFN,.09,"E"))="") S DR=DR_".09;",SSNP=1 ;SSN
  1. ..I DR'="" D
  1. ...D WRTLN
  1. ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
  1. ...D ^DIE K DA,DIE,DR,DIC,DIQ
  1. ...;if SSN was prompted then reinitialize SSN ARRAY variable
  1. ...I SSNP=1 S MPIFARR(2,DFN,.09,"E")="" S DIC=2,DR=".09" S DA=DFN,DA(2.01)=1,DIQ(0)="E",DIQ="MPIFARR" D EN^DIQ1 K DA,DIC,DIQ,DR
  1. ...;**44 if the PSEUDO SSN REASON field exist
  1. ..S DR="" ;reset DR to null to be able to concatenate the fields together since DR was just killed above
  1. ..I $D(MPIFARR(2,DFN,.0906,"I")) D
  1. ...;check to see if the SSN is a PSEUDO and the PSEUDO SSN REASON is null or "S" (FOLLOW-UP REQUIRED), if so add PSEUDO SSN REASON to the prompted fields
  1. ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="") S DR=DR_".0906;" ;**48 correct when SSN is prompted
  1. ...I MPIFARR(2,DFN,.09,"E")["P",(MPIFARR(2,DFN,.0906,"I")="S") S DR=DR_".09;" ;**48 correct when SSN is prompted
  1. ..I $G(MPIFARR(2,DFN,994,"I"))="" S DR=DR_"994;" ;MULTIPLE BIRTH INDICATOR
  1. ..S MPIMMN=$G(MPIFARR(2,DFN,.2403,"E")) ;MOTHER'S MAIDEN NAME
  1. ..I $$VALDT(MPIMMN) S DR=DR_".2403;" ;Validate MMN value
  1. ..S MPICTY=$G(MPIFARR(2,DFN,.092,"E")) ;PLACE OF BIRTH [CITY]
  1. ..S MPIST=$G(MPIFARR(2,DFN,.093,"E")) ;PLACE OF BIRTH [STATE]
  1. ..I $S($$VALDT(MPICTY):1,$$VALDT(MPIST):1,1:0) S DR=DR_".092;.093;" ;Validate POB [CITY] & [STATE] value
  1. ..I $G(MPIFARR(2.01,1,.01,"E"))="" S DR=DR_"1",DR(2,2.01)=".01;1" ;ALIAS **44 ADDING ALIAS SSN TO FIELDS
  1. ..I DR'="" D
  1. ...D WRTLN
  1. ...S DIE="^DPT(",DA=DFN,DIE("NO^")="BACK"
  1. ...D ^DIE K DA,DIE,DR,DIC,DIQ
  1. L -^DPT(DFN)
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. K MPIFRTN D VTQ^MPIFQ0
  1. ;**43 No longer get list of potential matches to pick from
  1. ;I $G(MPIFRTN)="" D
  1. ;. ^ Quit at LM screen when presented with a list of possible matches
  1. ;. \/ setup Local ICN and proceed
  1. ;.N ICN,ERR
  1. ;.S ICN=$$EN2^MPIFAPI()
  1. ;.Q:ICN=""!(+ICN=-1)
  1. ;.S ERR=$$SETICN^MPIF001(DFN,+ICN,$P(ICN,"V",2))
  1. ;.Q:+ERR=-1
  1. ;. ^ couldn't set ICN don't set other fields
  1. ;.S ERR=$$SETLOC^MPIF001(DFN,1),ERR=$$CHANGE^MPIF001(DFN,$P($$SITE^VASITE,"^"))
  1. K MPIFRTN,ZTREQ
  1. Q
  1. ;
  1. MPIQQ(PDFN) ; Entry point for queuing d/c
  1. ; Returned is -1^error message OR Task #
  1. Q:'$D(PDFN) "-1^No DFN passed"
  1. S ZTRTN="MPIQ^MPIFAPI(PDFN)"
  1. I $D(DUZ) S ZTSAVE("DUZ")=DUZ
  1. S ZTSAVE("PDFN")=PDFN,ZTSAVE("MPIFS")=1
  1. ; ^ silent flag
  1. S ZTIO="",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,1,0)
  1. D ^%ZTLOAD
  1. D HOME^%ZIS K IO("Q")
  1. N TSK S TSK=ZTSK
  1. K ZTSAVE,ZTRTN,ZTIO,ZTDTH,ZTSK
  1. Q TSK
  1. ;
  1. WRTLN ;**37 Write intro text ONLY if there are fields to ask
  1. W !!,"Please verify or update the following information:",!
  1. Q
  1. ;
  1. VALDT(VAL) ;**37 Validate value passed in.
  1. ;Prompt if field contains invalid data (e.g., UNKNOWN, NOT KNOWN, etc.)
  1. ;Returns 0 if not found
  1. ;Returns 1 if found
  1. I VAL="" Q 1
  1. I $E($$UP^XLFSTR(VAL),1,3)="UNK" Q 1
  1. I $E($$UP^XLFSTR(VAL),1,4)="NONE" Q 1
  1. I $E($$UP^XLFSTR(VAL),1,4)="NOT " Q 1
  1. I $$UP^XLFSTR(VAL)["UNAVAILABLE" Q 1
  1. I $$UP^XLFSTR(VAL)["DECEASED" Q 1
  1. I $E($$UP^XLFSTR(VAL),1,2)="DC" Q 1
  1. Q 0
  1. ;
  1. VIC40(DFN,ICN) ; -- only allowed for approved package use
  1. ; this will file the FULL icn for a patient and update correlations
  1. ; so the local site is now a subscribing package. This is used with the
  1. ; VIC 4.0 card registration where PV data was obtained from MVI.
  1. ;*56 (elz)
  1. N MPIX,TIME,LIST
  1. S TIME=$$NOW^XLFDT
  1. S INDEX=1
  1. D UPDATE^MPIFQ0(DFN,ICN,"")
  1. Q
  1. ;
  1. CARDLOG(MPIFID,MPIFTYPE,MPIFEVNT) ; - Function to log cards swiped or scanned
  1. ; input: MPIFID = ID from card swiped or scanned
  1. ; MPIFTYPE = type of card, either VHIC or CAC
  1. ; MPIFEVNT = type of event, either SWIPE or SCAN
  1. N MPIFNEXT
  1. I '$G(MPIFID) Q
  1. I $G(MPIFTYPE)'="VHIC",$G(MPIFTYPE)'="CAC" Q
  1. I $G(MPIFEVNT)'="SWIPE",$G(MPIFEVNT)'="SCAN" Q
  1. L +^XTMP("MPIFCARD",0):5
  1. S MPIFID=MPIFID_$S(MPIFTYPE="VHIC":"~PI~USVHA~742V1",1:"~NI~USDOD~200DOD")
  1. S ^XTMP("MPIFCARD",0)=$$FMADD^XLFDT(DT,90)_"^"_DT_"^"_"VHIC/CAC card swipe/scan log"
  1. S MPIFNEXT=$O(^XTMP("MPIFCARD",DT,":"),-1)+1
  1. S ^XTMP("MPIFCARD",DT,MPIFNEXT)=$$NOW^XLFDT_"^"_MPIFID_"^"_MPIFTYPE_"^"_MPIFEVNT_"^"_$P($G(XQY0),"^",2)
  1. L -^XTMP("MPIFCARD",0)
  1. Q