AUPATLK.m

AUPATLK ;IHS PATIENT LOOK-UP UTILITY [ 08/21/87  10:54 AM ]

 ;IHS-OKLA CITY AREA OFFICE-LMD

Z G NOASK:$D(AUNOASK)

LKUP W !!,"Select PATIENT: " K DFLT,DIC("S") I $D(DFN),DFN'="" K:'$D(^AUPNPAT(DFN,41,DUZ(2))) DFN I $D(DFN),$D(^DPT(DFN,0)) W $P(^(0),"^",1),"//"

 D SBRS Q:$D(DFOUT)!$D(DUOUT)!$D(DTOUT)!$D(DLOUT)

NOASK I $D(DQOUT) D QUES G LKUP:'$D(NOASK),END

 I Y=" ",$D(^DISV($I,"AUPATLK")),$D(^DPT(^("AUPATLK"),0)) S Y=$P(^(0),"^",1) W:'$D(DFN) Y

 S (X,LX)=Y,DIC(0)="QZEM" G CHART:+X>0 S DIC("S")="I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)=""""",DIC="^DPT("

OPT I $D(AGOPT(11)),AGOPT(11)'="Y" S DIC("S")="D DEADY^AGMAN I '$D(AG(""DEAD"")),$D(^AUPNPAT(Y,41,DUZ(2),0)),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

LKUP1 S DIC("W")="W:$X>46 ! W ?48,$J($P(^AUPNPAT(Y,41,DUZ(2),0),U,2),6) W ?56,$P(^DPT(Y,0),U,9),?69 S RGG=$P(^DPT(Y,0),U,3) I RGG'="""" S RGG=$E(RGG,4,5)_""-""_$E(RGG,6,7)_""-""_($E(RGG,1,3)+1700) W $J(RGG,10)"

L1 G L2:+LX>0 D ^AUNMLK G NO:+Y<0 S DFN=+Y G END

L2 W ! D IX^DIC G NO:+Y<0 S DFN=+Y G END

CHART S (X,LX)=+X,DIC("S")="I $D(^AUPNPAT(""D"",LX,Y,DUZ(2))),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

OPTCH I $D(AGOPT(11)),AGOPT(11)'="Y" S DIC("S")="D DEADY^AGMAN I '$D(AG(""DEAD"")),$D(^AUPNPAT(""D"",LX,Y,DUZ(2))),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

 S D="D",DIC="^AUPNPAT(" G LKUP1

QUES W !!,"Please enter:",!,"  a) the PATIENT'S NAME (HORSECHIEF,ALLEN J) or",!,"  b) the IHS CHART NUMBER." Q

NO I '$D(AUNOASK) G LKUP

END K DIC("S"),RGG I $D(DFN) S ^DISV($I,"AUPATLK")=DFN

 Q

SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,DFOUT)="" Q

 S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""

 Q

AUPATLK   ;IHS PATIENT LOOK-UP UTILITY [ 08/21/87  10:54 AM ]

 +1       ;IHS-OKLA CITY AREA OFFICE-LMD

Z          IF $DATA(AUNOASK)

               GOTO NOASK

LKUP       WRITE !!,"Select PATIENT: "

           KILL DFLT,DIC("S")

           IF $DATA(DFN)

               IF DFN'=""

                   IF '$DATA(^AUPNPAT(DFN,41,DUZ(2)))

                       KILL DFN

                   IF $DATA(DFN)

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

                           WRITE $PIECE(^(0),"^",1),"//"

 +1        DO SBRS

           IF $DATA(DFOUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DLOUT)

               QUIT 

NOASK      IF $DATA(DQOUT)

               DO QUES

               IF '$DATA(NOASK)

                   GOTO LKUP

               GOTO END

 +1        IF Y=" "

               IF $DATA(^DISV($IO,"AUPATLK"))

                   IF $DATA(^DPT(^("AUPATLK"),0))

                       SET Y=$PIECE(^(0),"^",1)

                       IF '$DATA(DFN)

                           WRITE Y

 +2        SET (X,LX)=Y

           SET DIC(0)="QZEM"

           IF +X>0

               GOTO CHART

           SET DIC("S")="I $D(^AUPNPAT(Y,41,DUZ(2),0)),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

           SET DIC="^DPT("

OPT        IF $DATA(AGOPT(11))

               IF AGOPT(11)'="Y"

                   SET DIC("S")="D DEADY^AGMAN I '$D(AG(""DEAD"")),$D(^AUPNPAT(Y,41,DUZ(2),0)),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

LKUP1      SET DIC("W")="W:$X>46 ! W ?48,$J($P(^AUPNPAT(Y,41,DUZ(2),0),U,2),6) W ?56,$P(^DPT(Y,0),U,9),?69 S RGG=$P(^DPT(Y,0),U,3) I RGG'="""" S RGG=$E(RGG,4,5)_""-""_$E(RGG,6,7)_""-""_($E(RGG,1,3)+1700) W $J(RGG,10)"

L1         IF +LX>0

               GOTO L2

           DO ^AUNMLK

           IF +Y<0

               GOTO NO

           SET DFN=+Y

           GOTO END

L2         WRITE !

           DO IX^DIC

           IF +Y<0

               GOTO NO

           SET DFN=+Y

           GOTO END

CHART      SET (X,LX)=+X

           SET DIC("S")="I $D(^AUPNPAT(""D"",LX,Y,DUZ(2))),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

OPTCH      IF $DATA(AGOPT(11))

               IF AGOPT(11)'="Y"

                   SET DIC("S")="D DEADY^AGMAN I '$D(AG(""DEAD"")),$D(^AUPNPAT(""D"",LX,Y,DUZ(2))),$P(^AUPNPAT(Y,41,DUZ(2),0),U,3)="""""

 +1        SET D="D"

           SET DIC="^AUPNPAT("

           GOTO LKUP1

QUES       WRITE !!,"Please enter:",!,"  a) the PATIENT'S NAME (HORSECHIEF,ALLEN J) or",!,"  b) the IHS CHART NUMBER."

           QUIT 

NO         IF '$DATA(AUNOASK)

               GOTO LKUP

END        KILL DIC("S"),RGG

           IF $DATA(DFN)

               SET ^DISV($IO,"AUPATLK")=DFN

 +1        QUIT 

SBRS       KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

           READ Y:DTIME

           IF '$TEST

               WRITE *7

               READ Y:5

               IF Y="."

                   GOTO SBRS

               IF '$TEST

                   SET (DTOUT,DFOUT)=""

                   QUIT 

 +1        IF Y=""

               SET DLOUT=""

           IF Y="^"

               SET (DUOUT,Y)=""

           IF Y?1"?".E!(Y["^")

               SET (DQOUT,Y)=""

 +2        QUIT