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