AUPATDIC.m

AUPATDIC ; IHS/ACC - GATEWAY TO IHS GENERAL PATIENT LOOKUP ; [ 02/18/87  8:01 AM ]

 I $D(AU)#2 S:AU'[U AU=U_AU D @AU G COMMON

 G:DIPGM(0)=2 EN2

EN1 ; FIRST ENTRY FROM DIC

 S AUIHADA=0 S:'$D(DIC("W")) DIC("W")=""

 I DIC(0)["A" S AUIHADA=1 S:'$D(DIC("A")) DIC("A")="Select PATIENT: " S:$E(DIC("A"),1,3)="VA " DIC("A")=$E(DIC("A"),4,255)

 G:DIC(0)["A" ASK^DIC

EN2 ; SECOND ENTRY FROM DIC OR FALL-THROUGH IF NO 'ASK' INDICATED

 K DIC("A") ;**********

 S:'$D(AUIHADA) AUIHADA=0

 I $D(DIC("W")),DIC("W")="" K DIC("W")

 I DIC'="^AUPNPAT(",DIC'="^DPT(" G RTN^DIC

 G:"`^ "[$E(X) RTN^DIC

 I X="?BAD" S Y=-1 Q

 I X'["?",'$D(DUZ(2)) S DUZ(2)=0 W:DIC(0)["A" !,*7,"WARNING: SITE NUMBER SET TO 0 (""UNIVERSAL"")",!

 D ^AUIHSPAT

 I Y<0,U'[X S:AUIHADA&(DIC(0)'["A") DIC(0)=DIC(0)_"A" I DIC(0)["A" S DIPGM(0)=1,D="B" G AUPATDIC

 K AUIHADA

COMMON ;

 I $D(DIC(0)),DIC(0)["Z",+Y>0 S Y(0)=^DPT(+Y,0)

 Q

AUPATDIC  ; IHS/ACC - GATEWAY TO IHS GENERAL PATIENT LOOKUP ; [ 02/18/87  8:01 AM ]

 +1        IF $DATA(AU)#2

               IF AU'[U

                   SET AU=U_AU

               DO @AU

               GOTO COMMON

 +2        IF DIPGM(0)=2

               GOTO EN2

EN1       ; FIRST ENTRY FROM DIC

 +1        SET AUIHADA=0

           IF '$DATA(DIC("W"))

               SET DIC("W")=""

 +2        IF DIC(0)["A"

               SET AUIHADA=1

               IF '$DATA(DIC("A"))

                   SET DIC("A")="Select PATIENT: "

               IF $EXTRACT(DIC("A"),1,3)="VA "

                   SET DIC("A")=$EXTRACT(DIC("A"),4,255)

 +3        IF DIC(0)["A"

               GOTO ASK^DIC

EN2       ; SECOND ENTRY FROM DIC OR FALL-THROUGH IF NO 'ASK' INDICATED

 +1       ;**********

           KILL DIC("A")

 +2        IF '$DATA(AUIHADA)

               SET AUIHADA=0

 +3        IF $DATA(DIC("W"))

               IF DIC("W")=""

                   KILL DIC("W")

 +4        IF DIC'="^AUPNPAT("

               IF DIC'="^DPT("

                   GOTO RTN^DIC

 +5        IF "`^ "[$EXTRACT(X)

               GOTO RTN^DIC

 +6        IF X="?BAD"

               SET Y=-1

               QUIT 

 +7        IF X'["?"

               IF '$DATA(DUZ(2))

                   SET DUZ(2)=0

                   IF DIC(0)["A"

                       WRITE !,*7,"WARNING: SITE NUMBER SET TO 0 (""UNIVERSAL"")",!

 +8        DO ^AUIHSPAT

 +9        IF Y<0

               IF U'[X

                   IF AUIHADA&(DIC(0)'["A")

                       SET DIC(0)=DIC(0)_"A"

                   IF DIC(0)["A"

                       SET DIPGM(0)=1

                       SET D="B"

                       GOTO AUPATDIC

 +10       KILL AUIHADA

COMMON    ;

 +1        IF $DATA(DIC(0))

               IF DIC(0)["Z"

                   IF +Y>0

                       SET Y(0)=^DPT(+Y,0)

 +2        QUIT