source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCPATA.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1DVBCPATA ;ALB/JLU,557/THM-ADD NEW VET TO FILE #2 ; 10/4/91 9:22 AM
2 ;;2.7;AMIE;**1,23,40,42,55,77**;Apr 10, 1995
3 ;
4EN ;determine if new patient
5 S OLDHD1=HD1,HD1="Additional Veteran Information"
6 K DVBCNEW,OUT,EDIT
7 S DIC="^DPT(",DIC(0)="AELMQ",DLAYGO=2
8 D ^DIC
9 K DLAYGO
10 I Y<0 S OUT=1 D EXIT1 Q
11 S DVBADA=+Y
12 I $P(Y,U,3) S DVBCNEW=1 D MPI(,DVBADA)
13 S DA=DVBADA
14 ;
15ADDR I '$D(DVBCNEW) S DTA=^DPT(DA,0),PNAM=$P(DTA,U,1),SSN=$P(DTA,U,9),DFN=DA,CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") S:CNUM="" CNUM="Unknown"
16 ;
17ASK K %Y I '$D(DVBCNEW) D ADDR^DVBCUTIL W !,"Is this the correct Veteran" S %=2 D YN^DICN I $D(DTOUT)!(%<0) S OUT=1 G EXIT
18 I $D(%Y) I %Y["?" W !!,"Enter Y if it is the correct Veteran, N to reselect",! G ASK
19 K %Y I '$D(DVBCNEW),$D(%),%'=1 D CLR G EN
20 ;
21ASKED1 I $D(EDIT) S DIE="^DPT(",DR="W @IOF,!,""Edit Veteran Data"",!!!;.02;.09;.313;.314;.361;.525;.323;1901;.111;.112:.115;.1112;.117;.131;.132;.326;.327" D ^DIE S EDIT=1
22 ;
23ASKED2 I $D(EDIT) W !!,"Want to edit it again" S %=1 D YN^DICN G:%=1 ASKED1 S:$D(DTOUT)!(%<0) OUT=1 I $D(OUT) G EXIT
24 I $D(%Y),%Y["?" W !!,"Enter Y to edit the information again or N to skip.",!! H 3 G ASKED2
25 W !! G EXIT1:'$D(DVBCNEW)
26 S DIE("NO^")="BACKOUTOK",DIE="^DPT(",DR="[DVBA C ADD 2507 PAT]" D ^DIE K DIE("NO^") S EDIT=1
27 I $D(DVBACPLT),DVBACPLT=0 DO
28 .;Aborting C&P request due to incomplete Patient required information.
29 .N VAR
30 .S VAR(1,0)="1,5,0,2,0^...Error, required information missing!...."
31 .S VAR(2,0)="0,7,0,1:2,0^...Unable to complete, Request aborted!....."
32 .D WR^DVBAUTL4("VAR")
33 .D CONTMES^DVBCUTL4
34 .S OUT=""
35 .K VAR
36 I $D(DVBACPLT),DVBACPLT=0 D EXIT1 QUIT ;**QUIT w/out D EXIT
37 ;
38EXIT S DTA=^DPT(DA,0),PNAM=$P(DTA,U,1),SSN=$P(DTA,U,9),DFN=DA,CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") S:CNUM="" CNUM="Unknown"
39 I $D(DVBCNEW) S XMB="DVBA C NEW C&P VETERAN",XMB(1)=PNAM,XMB(2)=SSN,XMB(3)=$S($D(^VA(200,+DUZ,0)):$P(^(0),U),1:"Unknown user"),Y=DT X ^DD("DD") S XMB(4)=Y D ^XMB
40EXIT1 S HD1=OLDHD1 K OLDHD1,DIC,DIE,DR,%,%Y,DTA,X,Y,DVBCNEW,DVBADA,DVBACPLT Q
41 ;
42CLR W @IOF,!?(IOM-$L(HD1)\2),HD1,!!
43 Q
44MPI(DVBBKMSG,DFN) ;MPI call to set ICN
45 ;check to see if CIRN PD/MPI is installed
46 I $D(DG20NAME) K DG20NAME
47 N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
48 K MPIFRTN
49 S MPIFS=1
50 D MPIQ^MPIFAPI(DFN)
51 K MPIFRTN
52 Q
Note: See TracBrowser for help on using the repository browser.