| 1 | DVBCPATA ;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 | ;
|
|---|
| 4 | EN ;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 | ;
|
|---|
| 15 | ADDR 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 | ;
|
|---|
| 17 | ASK 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 | ;
|
|---|
| 21 | ASKED1 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 | ;
|
|---|
| 23 | ASKED2 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 | ;
|
|---|
| 38 | EXIT 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
|
|---|
| 40 | EXIT1 S HD1=OLDHD1 K OLDHD1,DIC,DIE,DR,%,%Y,DTA,X,Y,DVBCNEW,DVBADA,DVBACPLT Q
|
|---|
| 41 | ;
|
|---|
| 42 | CLR W @IOF,!?(IOM-$L(HD1)\2),HD1,!!
|
|---|
| 43 | Q
|
|---|
| 44 | MPI(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
|
|---|
