- 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 Jan 18, 2025@03:12 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