ACDREG.m

ACDREG ;IHS/ADC/EDE/KML - PATIENT INQUIR;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN ;EP

 ;//[ACDREG]

 ;

 ;W @IOF

 ;S:'$D(ACDLINE) $P(ACDLINE,"=",80)="="

 ;W !!,"SIGN ON PROGRAM is: ",$P(^AUTTLOC(DUZ(2),0),U,2),!,ACDLINE,!

 S ACDDUZ(2)=DUZ(2),DUZ(2)=0

 F  D PAT I Y<0 D K Q

 Q

 ;

PAT ; DO ONE PATIENT

 S DIC("A")="Inquire on patient: "

 S DUZ(2)=ACDDUZ(2)

 S DIC(0)="AEQMI",DIC="^DPT(" D ^DIC I Y<0 Q

 S DUZ(2)=ACDDUZ(2)

 I '$D(^AUPNPAT(+Y,0)) W !!!,$P(^DPT(+Y,0),U)," 'IS NOT' registered for your sign on program."

 I  W !!,"This means: CDMIS data entry for this patient 'IS NOT' allowed." Q

 W !!!,$P(^DPT(+Y,0),U)," 'IS' registered for your sign on program."

 W !,"This means: CDMIS data entry for this patient 'IS' allowed.",!

 Q

K ;

 K ACDLINE,DIC,Y

 Q

ACDREG    ;IHS/ADC/EDE/KML - PATIENT INQUIR;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

EN        ;EP

 +1       ;//[ACDREG]

 +2       ;

 +3       ;W @IOF

 +4       ;S:'$D(ACDLINE) $P(ACDLINE,"=",80)="="

 +5       ;W !!,"SIGN ON PROGRAM is: ",$P(^AUTTLOC(DUZ(2),0),U,2),!,ACDLINE,!

 +6        SET ACDDUZ(2)=DUZ(2)

           SET DUZ(2)=0

 +7        FOR 

               DO PAT

               IF Y<0

                   DO K

                   QUIT 

 +8        QUIT 

 +9       ;

PAT       ; DO ONE PATIENT

 +1        SET DIC("A")="Inquire on patient: "

 +2        SET DUZ(2)=ACDDUZ(2)

 +3        SET DIC(0)="AEQMI"

           SET DIC="^DPT("

           DO ^DIC

           IF Y<0

               QUIT 

 +4        SET DUZ(2)=ACDDUZ(2)

 +5        IF '$DATA(^AUPNPAT(+Y,0))

               WRITE !!!,$PIECE(^DPT(+Y,0),U)," 'IS NOT' registered for your sign on program."

 +6       IF $TEST

               WRITE !!,"This means: CDMIS data entry for this patient 'IS NOT' allowed."

               QUIT 

 +7        WRITE !!!,$PIECE(^DPT(+Y,0),U)," 'IS' registered for your sign on program."

 +8        WRITE !,"This means: CDMIS data entry for this patient 'IS' allowed.",!

 +9        QUIT 

K         ;

 +1        KILL ACDLINE,DIC,Y

 +2        QUIT