- 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
