53 lines
2.2 KiB
Mathematica
53 lines
2.2 KiB
Mathematica
DVBCPATA ;ALB/JLU,557/THM-ADD NEW VET TO FILE #2 ; 10/4/91 9:22 AM
|
|
;;2.7;AMIE;**1,23,40,42,55,77**;Apr 10, 1995
|
|
;
|
|
EN ;determine if new patient
|
|
S OLDHD1=HD1,HD1="Additional Veteran Information"
|
|
K DVBCNEW,OUT,EDIT
|
|
S DIC="^DPT(",DIC(0)="AELMQ",DLAYGO=2
|
|
D ^DIC
|
|
K DLAYGO
|
|
I Y<0 S OUT=1 D EXIT1 Q
|
|
S DVBADA=+Y
|
|
I $P(Y,U,3) S DVBCNEW=1 D MPI(,DVBADA)
|
|
S DA=DVBADA
|
|
;
|
|
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"
|
|
;
|
|
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
|
|
I $D(%Y) I %Y["?" W !!,"Enter Y if it is the correct Veteran, N to reselect",! G ASK
|
|
K %Y I '$D(DVBCNEW),$D(%),%'=1 D CLR G EN
|
|
;
|
|
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
|
|
;
|
|
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
|
|
I $D(%Y),%Y["?" W !!,"Enter Y to edit the information again or N to skip.",!! H 3 G ASKED2
|
|
W !! G EXIT1:'$D(DVBCNEW)
|
|
S DIE("NO^")="BACKOUTOK",DIE="^DPT(",DR="[DVBA C ADD 2507 PAT]" D ^DIE K DIE("NO^") S EDIT=1
|
|
I $D(DVBACPLT),DVBACPLT=0 DO
|
|
.;Aborting C&P request due to incomplete Patient required information.
|
|
.N VAR
|
|
.S VAR(1,0)="1,5,0,2,0^...Error, required information missing!...."
|
|
.S VAR(2,0)="0,7,0,1:2,0^...Unable to complete, Request aborted!....."
|
|
.D WR^DVBAUTL4("VAR")
|
|
.D CONTMES^DVBCUTL4
|
|
.S OUT=""
|
|
.K VAR
|
|
I $D(DVBACPLT),DVBACPLT=0 D EXIT1 QUIT ;**QUIT w/out D EXIT
|
|
;
|
|
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"
|
|
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
|
|
EXIT1 S HD1=OLDHD1 K OLDHD1,DIC,DIE,DR,%,%Y,DTA,X,Y,DVBCNEW,DVBADA,DVBACPLT Q
|
|
;
|
|
CLR W @IOF,!?(IOM-$L(HD1)\2),HD1,!!
|
|
Q
|
|
MPI(DVBBKMSG,DFN) ;MPI call to set ICN
|
|
;check to see if CIRN PD/MPI is installed
|
|
I $D(DG20NAME) K DG20NAME
|
|
N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
|
|
K MPIFRTN
|
|
S MPIFS=1
|
|
D MPIQ^MPIFAPI(DFN)
|
|
K MPIFRTN
|
|
Q
|