AUPNLKUT.m

AUPNLKUT ; IHS/CMI/LAB - IHS PATIENT LOOKUP, COMMON FUNCTIONS ;

 ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 ;

 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ;

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

 .D EN^DDIOL(AUPNUM_"  "_$S($P(AUPS(AUPIFN),U)'=$P(AUPS(AUPIFN),U,2):$P(AUPS(AUPIFN),U,2)_"  ",1:"  ")_$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

AUPNLKUT  ; IHS/CMI/LAB - IHS PATIENT LOOKUP, COMMON FUNCTIONS ;

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);;MAR 09, 1999

 +2       ;

 +3       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +4       ;

SETAUP    ; EP -EXTERNAL ENTRY POINT

 +1        IF '$DATA(^DPT(Y,0))!($DATA(AUPS(Y))&(DIC(0)'["C"))

               QUIT 

 +2       ;X:($D(DO("SCR"))) DO("SCR") Q:'$T  ; ** ignore master screen **

           SET X=AUPX

           IF 1

               IF $DATA(DIC("S"))

                   XECUTE DIC("S")

               IF '$TEST

                   QUIT 

 +3        SET AUPCNT=AUPCNT+1

           SET AUPLNE=$SELECT($DATA(DDS):3,1:5)

           SET AUPS(Y)=$PIECE(^DPT(Y,0),U)_U_$SELECT($DATA(AUPVAL):AUPVAL,1:AUPX)

           SET AUPIFNS(AUPCNT)=Y

           IF $DATA(AUPNMCVN)

               SET AUPNICK(Y)=""

           IF '(AUPCNT#AUPLNE)

               IF DIC(0)["E"

                   DO PRTAUP

 +4        KILL AUPLNE

 +5        QUIT 

 +6       ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 +7       ;

PRTAUP    ; EP - EXTERNAL ENTRY POINT

 +1        FOR AUPNUM=AUPNUM+1:1:AUPCNT

               SET (AUPIFN,Y)=+AUPIFNS(AUPNUM)

               Begin DoDot:1

 +2                DO EN^DDIOL(AUPNUM_"  "_$SELECT($PIECE(AUPS(AUPIFN),U)'=$PIECE(AUPS(AUPIFN),U,2):$PIECE(AUPS(AUPIFN),U,2)_"  ",1:"  ")_$PIECE(AUPS(AUPIFN),U),"","!?3")

                   IF $DATA(^DPT(AUPIFN,0))

                       XECUTE DIC("W")

               End DoDot:1

 +3        IF '$DATA(AUP("NOPRT^"))

               DO EN^DDIOL("ENTER '^' TO STOP, OR","","!")

           DO EN^DDIOL("CHOOSE "_AUPBEG_"-"_AUPNUM_": ","","!")

           READ X:DTIME

           IF X?.E1C.E

               SET X="^"

           SET AUPSEL=X

           IF '$TEST

               SET AUPSEL=AUPX

               SET DTOUT=1

           IF AUPSEL=""

               QUIT 

 +4        SET AUPDFN=$SELECT(AUPSEL'?.ANP!($LENGTH(AUPSEL)>30):-1,'$DATA(AUPIFNS(AUPSEL)):-1,$DATA(AUPS(+AUPIFNS(AUPSEL))):+AUPIFNS(AUPSEL),1:-1)

           SET AUPX=$SELECT(AUPDFN<0:AUPSEL,1:AUPX)

 +5        QUIT