DPTLK4 ;ALB/JFP - MAS Patient Look-up Create stub entry patient file ; 09/01/96
;;5.3;Registration;**73,857,915,919**;Aug 13, 1993;Build 4
FILE(FLDARR,DGVIC40) ; -- Creates stub in patient file
;Inputs:
; FLDARR - array of field elements to file
; DGVIC40 - flag indicating VIC 4.0 card
;Outputs:
; 0 - sucess
; -1^error -
;
; *857 made changes to support new vic 4.0 card (elz)
;
; -- Check input
Q:'$D(FLDARR) "-1^required parameter not passed"
; -- New variables
N Y,Z,DIC,SAVY
;
; -- Create stub entry in patient file
S DIC="^DPT(",DIC(0)="EL",DLAYGO=2
;
; -- Set X = patient name
S X=$S($G(DGVIC40):$G(@FLDARR@(.01)),1:$G(@FLDARR@(2)))
;
; -- if VIC 4.0 card DIR string =
; SEX;DOB;SSN;POBCity;POBState;MMN;ICN;ICNCheck;MBI
I $G(DGVIC40) S DIC("DR")="",Z=.01 F S Z=$O(@FLDARR@(Z)) Q:'Z S:Z'=991.01&(Z'=991.02) DIC("DR")=DIC("DR")_Z_$S($L(@FLDARR@(Z)):"///"_@FLDARR@(Z),1:"")_";"
;
; -- add in other fields for prompt PATIENT TYPE;VETERAN;SC;MBI
I S DIC("DR")=DIC("DR")_"391;1901;.301"
;
; -- Set DIR string (old VIC) = SEX;DOB;SSN;PATIENT TYPE;VETERAN;SC
E S DIC("DR")=".02///"_$G(@FLDARR@(4))_";.03///"_$G(@FLDARR@(3))_";.09////"_$G(@FLDARR@(1))_";391///"_$G(@FLDARR@(5))_";1901///"_$G(@FLDARR@(6))_";.301///"_$G(@FLDARR@(7))
;
; -- set date entered into file (missing from prior vic versions)
S DIC("DR")=DIC("DR")_";.097////"_DT
; -- set who entered (missing from prior vic versions)
S:$G(DUZ) DIC("DR")=DIC("DR")_";.096////"_DUZ
;
K DD,DO D FILE^DICN S SAVY=Y
K DIC,DLAYGO,X
;
; need to update mpi with icn/correlation
I Y>0,$G(@FLDARR@(991.01)),$G(@FLDARR@(991.02)),$T(VIC40^MPIFAPI)'="" D VIC40^MPIFAPI(+Y,@FLDARR@(991.01)_"V"_@FLDARR@(991.02))
;
; -- send bulletin for newly added patient
I SAVY>0 D BULL^DPTLK7(+SAVY)
;
Q SAVY
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDPTLK4 1865 printed Sep 23, 2025@20:36:50 Page 2
DPTLK4 ;ALB/JFP - MAS Patient Look-up Create stub entry patient file ; 09/01/96
+1 ;;5.3;Registration;**73,857,915,919**;Aug 13, 1993;Build 4
FILE(FLDARR,DGVIC40) ; -- Creates stub in patient file
+1 ;Inputs:
+2 ; FLDARR - array of field elements to file
+3 ; DGVIC40 - flag indicating VIC 4.0 card
+4 ;Outputs:
+5 ; 0 - sucess
+6 ; -1^error -
+7 ;
+8 ; *857 made changes to support new vic 4.0 card (elz)
+9 ;
+10 ; -- Check input
+11 if '$DATA(FLDARR)
QUIT "-1^required parameter not passed"
+12 ; -- New variables
+13 NEW Y,Z,DIC,SAVY
+14 ;
+15 ; -- Create stub entry in patient file
+16 SET DIC="^DPT("
SET DIC(0)="EL"
SET DLAYGO=2
+17 ;
+18 ; -- Set X = patient name
+19 SET X=$SELECT($GET(DGVIC40):$GET(@FLDARR@(.01)),1:$GET(@FLDARR@(2)))
+20 ;
+21 ; -- if VIC 4.0 card DIR string =
+22 ; SEX;DOB;SSN;POBCity;POBState;MMN;ICN;ICNCheck;MBI
+23 IF $GET(DGVIC40)
SET DIC("DR")=""
SET Z=.01
FOR
SET Z=$ORDER(@FLDARR@(Z))
if 'Z
QUIT
if Z'=991.01&(Z'=991.02)
SET DIC("DR")=DIC("DR")_Z_$SELECT($LENGTH(@FLDARR@(Z)):"///"_@FLDARR@(Z),1:"")_";"
+24 ;
+25 ; -- add in other fields for prompt PATIENT TYPE;VETERAN;SC;MBI
+26 IF $TEST
SET DIC("DR")=DIC("DR")_"391;1901;.301"
+27 ;
+28 ; -- Set DIR string (old VIC) = SEX;DOB;SSN;PATIENT TYPE;VETERAN;SC
+29 IF '$TEST
SET DIC("DR")=".02///"_$GET(@FLDARR@(4))_";.03///"_$GET(@FLDARR@(3))_";.09////"_$GET(@FLDARR@(1))_";391///"_$GET(@FLDARR@(5))_";1901///"_$GET(@FLDARR@(6))_";.301///"_$GET(@FLDARR@(7))
+30 ;
+31 ; -- set date entered into file (missing from prior vic versions)
+32 SET DIC("DR")=DIC("DR")_";.097////"_DT
+33 ; -- set who entered (missing from prior vic versions)
+34 if $GET(DUZ)
SET DIC("DR")=DIC("DR")_";.096////"_DUZ
+35 ;
+36 KILL DD,DO
DO FILE^DICN
SET SAVY=Y
+37 KILL DIC,DLAYGO,X
+38 ;
+39 ; need to update mpi with icn/correlation
+40 IF Y>0
IF $GET(@FLDARR@(991.01))
IF $GET(@FLDARR@(991.02))
IF $TEXT(VIC40^MPIFAPI)'=""
DO VIC40^MPIFAPI(+Y,@FLDARR@(991.01)_"V"_@FLDARR@(991.02))
+41 ;
+42 ; -- send bulletin for newly added patient
+43 IF SAVY>0
DO BULL^DPTLK7(+SAVY)
+44 ;
+45 QUIT SAVY
+46 ;
