22 lines
1.3 KiB
Mathematica
22 lines
1.3 KiB
Mathematica
AUPNLKUT ; IHS/CMI/LAB - IHS PATIENT LOOKUP, COMMON FUNCTIONS ;12/26/06 11:02
|
|
;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
|
|
;
|
|
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
;
|
|
SETAUP ; EP -EXTERNAL ENTRY POINT
|
|
Q:'$D(^DPT(Y,0))!($D(AUPS(Y))&(DIC(0)'["C"))
|
|
S X=AUPX I 1 X:$D(DIC("S")) DIC("S") Q:'$T ;X:($D(DO("SCR"))) DO("SCR") Q:'$T ; ** ignore master screen **
|
|
S AUPCNT=AUPCNT+1,AUPLNE=$S($D(DDS):3,1:5),AUPS(Y)=$P(^DPT(Y,0),U)_U_$S($D(AUPVAL):AUPVAL,1:AUPX),AUPIFNS(AUPCNT)=Y S:$D(AUPNMCVN) AUPNICK(Y)="" I '(AUPCNT#AUPLNE),DIC(0)["E" D PRTAUP
|
|
K AUPLNE
|
|
Q
|
|
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
;
|
|
PRTAUP ; EP - EXTERNAL ENTRY POINT
|
|
F AUPNUM=AUPNUM+1:1:AUPCNT S (AUPIFN,Y)=+AUPIFNS(AUPNUM) D
|
|
.N AUPNL I $P(AUPS(AUPIFN),U)'=$P(AUPS(AUPIFN),U,2) S AUPNL=$P(AUPS(AUPIFN),U,2) I $G(AUPX),AUPNL=$G(AUPDT),AUPNL?7N S AUPNL=AUPX ;ECHO DOB CORRECTLY
|
|
.D EN^DDIOL(AUPNUM_" "_$G(AUPNL)_" "_$P(AUPS(AUPIFN),U),"","!?3")
|
|
.X:$D(^DPT(AUPIFN,0)) DIC("W")
|
|
D:'$D(AUP("NOPRT^")) EN^DDIOL("ENTER '^' TO STOP, OR","","!") D EN^DDIOL("CHOOSE "_AUPBEG_"-"_AUPNUM_": ","","!") R X:DTIME S:X?.E1C.E X="^" S AUPSEL=X S:'$T AUPSEL=AUPX,DTOUT=1 Q:AUPSEL=""
|
|
S AUPDFN=$S(AUPSEL'?.ANP!($L(AUPSEL)>30):-1,'$D(AUPIFNS(AUPSEL)):-1,$D(AUPS(+AUPIFNS(AUPSEL))):+AUPIFNS(AUPSEL),1:-1),AUPX=$S(AUPDFN<0:AUPSEL,1:AUPX)
|
|
Q
|