source: WorldVistAEHR/trunk/r/IHS_ROUTINES-AUP/AUPNLKUT.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1AUPNLKUT ; IHS/CMI/LAB - IHS PATIENT LOOKUP, COMMON FUNCTIONS ;12/26/06 11:02
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
3 ;
4 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
5 ;
6SETAUP ; EP -EXTERNAL ENTRY POINT
7 Q:'$D(^DPT(Y,0))!($D(AUPS(Y))&(DIC(0)'["C"))
8 S X=AUPX I 1 X:$D(DIC("S")) DIC("S") Q:'$T ;X:($D(DO("SCR"))) DO("SCR") Q:'$T ; ** ignore master screen **
9 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
10 K AUPLNE
11 Q
12 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
13 ;
14PRTAUP ; EP - EXTERNAL ENTRY POINT
15 F AUPNUM=AUPNUM+1:1:AUPCNT S (AUPIFN,Y)=+AUPIFNS(AUPNUM) D
16 .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
17 .D EN^DDIOL(AUPNUM_" "_$G(AUPNL)_" "_$P(AUPS(AUPIFN),U),"","!?3")
18 .X:$D(^DPT(AUPIFN,0)) DIC("W")
19 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=""
20 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)
21 Q
Note: See TracBrowser for help on using the repository browser.