Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DPTLK4

DPTLK4.m

Go to the documentation of this file.
  1. 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
  1. FILE(FLDARR,DGVIC40) ; -- Creates stub in patient file
  1. ;Inputs:
  1. ; FLDARR - array of field elements to file
  1. ; DGVIC40 - flag indicating VIC 4.0 card
  1. ;Outputs:
  1. ; 0 - sucess
  1. ; -1^error -
  1. ;
  1. ; *857 made changes to support new vic 4.0 card (elz)
  1. ;
  1. ; -- Check input
  1. Q:'$D(FLDARR) "-1^required parameter not passed"
  1. ; -- New variables
  1. N Y,Z,DIC,SAVY
  1. ;
  1. ; -- Create stub entry in patient file
  1. S DIC="^DPT(",DIC(0)="EL",DLAYGO=2
  1. ;
  1. ; -- Set X = patient name
  1. S X=$S($G(DGVIC40):$G(@FLDARR@(.01)),1:$G(@FLDARR@(2)))
  1. ;
  1. ; -- if VIC 4.0 card DIR string =
  1. ; SEX;DOB;SSN;POBCity;POBState;MMN;ICN;ICNCheck;MBI
  1. 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:"")_";"
  1. ;
  1. ; -- add in other fields for prompt PATIENT TYPE;VETERAN;SC;MBI
  1. I S DIC("DR")=DIC("DR")_"391;1901;.301"
  1. ;
  1. ; -- Set DIR string (old VIC) = SEX;DOB;SSN;PATIENT TYPE;VETERAN;SC
  1. 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))
  1. ;
  1. ; -- set date entered into file (missing from prior vic versions)
  1. S DIC("DR")=DIC("DR")_";.097////"_DT
  1. ; -- set who entered (missing from prior vic versions)
  1. S:$G(DUZ) DIC("DR")=DIC("DR")_";.096////"_DUZ
  1. ;
  1. K DD,DO D FILE^DICN S SAVY=Y
  1. K DIC,DLAYGO,X
  1. ;
  1. ; need to update mpi with icn/correlation
  1. 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))
  1. ;
  1. ; -- send bulletin for newly added patient
  1. I SAVY>0 D BULL^DPTLK7(+SAVY)
  1. ;
  1. Q SAVY
  1. ;