- 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 Jan 18, 2025@04:01:37 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 ;