ABPAPATL.m

ABPAPATL ;PRIV-INS PATIENT LOOK-UP UTILITY; [ 07/14/91  8:51 AM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

INIT K ABPAT,ABPAHRN,ABPAPSSN,ABPATDFN,ABPAPAT D XIT,DT^DICRW

 ;

PROMPT W "Select PATIENT NAME: " D

 .K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

 .R Y:DTIME I '$T W *7 R Y:5 G PROMPT:Y="." I '$T S (DTOUT,Y)="" Q

 .I Y="/.," S (DFOUT,Y)="" Q

 .I Y="" S DLOUT="" Q

 .I Y="^" S (DUOUT,Y)="" Q

 .I Y?1"?".E!(Y["^") S (DQOUT,Y)="" Q

 .Q

 I $D(DTOUT)!$D(DUOUT)!$D(DFOUT)!$D(DLOUT) G XIT

 I $D(DQOUT) S XQH="ABPAPATIENT" D EN^XQH G INIT

 K DIC S DIC="^ABPVAO(",DIC(0)="EZ",X=Y

 I $D(ABPASITE)=1 D

 .S DIC("S")="I $P(^ABPVAO(Y,0),""^"",2)=ABPASITE"

DIC S D="B" D IX^DIC ;NAME LOOK-UP

 I +Y<1 S D="D" D IX^DIC ;HRN LOOK-UP

 I +Y<1 S D="F" D IX^DIC ;SSN LOOK-UP

 I +Y<1 S D="I" D IX^DIC ;BILL ID LOOK-UP

 I +Y<1 S D="C" D IX^DIC ;DOS LOOK-UP

 I +Y<1 S D="E" D IX^DIC ;OTHER NAME LOOK-UP

 I +Y<1 I $D(ABPAPTN)=1 D

 .K D,ABPAPTN S DIC(0)="ELZ" D ^DIC

 I +Y>0 S (ABPATDFN,DA)=+Y,ABPAPAT=Y(0,0) I +$P(Y,"^",3)=1 D

 .K DIE S DIE="^ABPVAO(",DR=.04 D ^DIE

 I $D(ABPATDFN)'=1 W *7,"  ??" S ABPATDFN=""

 E  S ABPAHRN=$P(^ABPVAO(ABPATDFN,0),"^",3),ABPAPSSN=$P(^(0),"^",4)

 I $D(ABPAPSSN)=1 I $L(ABPAPSSN)=9 D

 .S ABPASSN=$E(ABPAPSSN,1,3)_"-"_$E(ABPAPSSN,4,5)_"-"_$E(ABPAPSSN,6,9)

 .S ABPAPSSN=ABPASSN K ABPASSN

XIT K DIC,X,Y,DTOUT,DUOUT,DFOUT,DLOUT,DQOUT,XQH,D

 Q

ABPAPATL  ;PRIV-INS PATIENT LOOK-UP UTILITY; [ 07/14/91  8:51 AM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

INIT       KILL ABPAT,ABPAHRN,ABPAPSSN,ABPATDFN,ABPAPAT

           DO XIT

           DO DT^DICRW

 +1       ;

PROMPT     WRITE "Select PATIENT NAME: "

           Begin DoDot:1

 +1            KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT

 +2            READ Y:DTIME

               IF '$TEST

                   WRITE *7

                   READ Y:5

                   IF Y="."

                       GOTO PROMPT

                   IF '$TEST

                       SET (DTOUT,Y)=""

                       QUIT 

 +3            IF Y="/.,"

                   SET (DFOUT,Y)=""

                   QUIT 

 +4            IF Y=""

                   SET DLOUT=""

                   QUIT 

 +5            IF Y="^"

                   SET (DUOUT,Y)=""

                   QUIT 

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

                   SET (DQOUT,Y)=""

                   QUIT 

 +7            QUIT 

           End DoDot:1

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

               GOTO XIT

 +9        IF $DATA(DQOUT)

               SET XQH="ABPAPATIENT"

               DO EN^XQH

               GOTO INIT

 +10       KILL DIC

           SET DIC="^ABPVAO("

           SET DIC(0)="EZ"

           SET X=Y

 +11       IF $DATA(ABPASITE)=1

               Begin DoDot:1

 +12               SET DIC("S")="I $P(^ABPVAO(Y,0),""^"",2)=ABPASITE"

               End DoDot:1

DIC       ;NAME LOOK-UP

           SET D="B"

           DO IX^DIC

 +1       ;HRN LOOK-UP

           IF +Y<1

               SET D="D"

               DO IX^DIC

 +2       ;SSN LOOK-UP

           IF +Y<1

               SET D="F"

               DO IX^DIC

 +3       ;BILL ID LOOK-UP

           IF +Y<1

               SET D="I"

               DO IX^DIC

 +4       ;DOS LOOK-UP

           IF +Y<1

               SET D="C"

               DO IX^DIC

 +5       ;OTHER NAME LOOK-UP

           IF +Y<1

               SET D="E"

               DO IX^DIC

 +6        IF +Y<1

               IF $DATA(ABPAPTN)=1

                   Begin DoDot:1

 +7                    KILL D,ABPAPTN

                       SET DIC(0)="ELZ"

                       DO ^DIC

                   End DoDot:1

 +8        IF +Y>0

               SET (ABPATDFN,DA)=+Y

               SET ABPAPAT=Y(0,0)

               IF +$PIECE(Y,"^",3)=1

                   Begin DoDot:1

 +9                    KILL DIE

                       SET DIE="^ABPVAO("

                       SET DR=.04

                       DO ^DIE

                   End DoDot:1

 +10       IF $DATA(ABPATDFN)'=1

               WRITE *7,"  ??"

               SET ABPATDFN=""

 +11      IF '$TEST

               SET ABPAHRN=$PIECE(^ABPVAO(ABPATDFN,0),"^",3)

               SET ABPAPSSN=$PIECE(^(0),"^",4)

 +12       IF $DATA(ABPAPSSN)=1

               IF $LENGTH(ABPAPSSN)=9

                   Begin DoDot:1

 +13                   SET ABPASSN=$EXTRACT(ABPAPSSN,1,3)_"-"_$EXTRACT(ABPAPSSN,4,5)_"-"_$EXTRACT(ABPAPSSN,6,9)

 +14                   SET ABPAPSSN=ABPASSN

                       KILL ABPASSN

                   End DoDot:1

XIT        KILL DIC,X,Y,DTOUT,DUOUT,DFOUT,DLOUT,DQOUT,XQH,D

 +1        QUIT