DPTLK4.m

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 ---DPTLK4   1865     printed  Apr 09, 2024@21:52:40                                                                                                                                                                                                      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      ;