ADEMNG1.m

ADEMNG1 ; IHS/HQT/MJL  - DENTAL FOLLOWUP MGT PT 2 ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

LINE W $E(ADELIN,1,40-($L(ADETITL)/2)),ADETITL,$E(ADELIN,1,39-($L(ADETITL)/2)) Q

RESET ;EP

 S ADETITL=" DENTAL "_$S(ADEREF:"REFERRAL",ADEWAI:"WAITING LIST",ADEREC:"RECALL")_$S($D(ADEFUNC):ADEFUNC,1:" MANAGEMENT ")

 D ^ADECLS,LINE

R2 ;EP

 K DIC S DIC("A")="Select "_$P(ADETITL," ",3)_" List: ",DIC("S")="I $P(^ADETYP(Y,0),U,4)=ADETYP",DIC="^ADETYP(",DIC(0)="AQEMZ" D ^DIC K DIC

 I Y<1 Q

 S ADESUB=$P(Y,U),ADESUBN=$P(Y,U,2),Y=1

 Q

PTLOOK ;EP

 D ^ADECLS D P1 Q:Y<1  D:ADEINT P2 S Y=1 Q

P1 S ADETITL=" "_ADESUBN_" "_$S(ADEREF:"REFERRAL",ADEWAI:"WAITING LIST",ADEREC:"RECALL")_$S($D(ADEFUNC):ADEFUNC,1:" MANAGEMENT ")

 K DIC,Y,ADEPAT D LINE R !!,"Select Dental Patient Name: ",X:DTIME

 I '$T!(X="")!(X["^") S Y=-1 Q

 I X["?" D PTHLP W ! W:'$D(ADEMDEL) " YOU MAY ADD A NEW PATIENT IF YOU WISH",! G P1

 S:$D(ADEMDEL) DIC("S")="I $D(^ADEFOL(""TYPE"",Y,ADETYP,ADESUB))"

 S DIC="^AUPNPAT(",DIC(0)="MEZQ" D ^DIC W ! K DIC

 G:Y<1 P1

 S ADEPAT=$P(Y,U)

 I $D(^ADEUTL("ADELOCK",ADEPAT)) W !!,"PATIENT'S RECORD CURRENTLY BEING EDITED.  TRY LATER." H 2 K ADEPAT,X D ^ADECLS G P1

 S ^ADEUTL("ADELOCK",ADEPAT)=""

 S ADENEWM=1 S:$D(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB)) ADENEWM=0,ADEMDFN=$O(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB,0))

 S Y=1 Q

P2 ;EP

 K Y

 ;

 S DIE("NO^")="OUTOK"

 S DIE="^DPT(",DR=".111;.114;.115;.116;.131",DA=ADEPAT D ^DIE

 ;

 Q:$D(Y)

 I '$D(^DPT(ADEPAT,.11)) S Y=1

 I '$D(Y) F J=1,4,5 I $P(^DPT(ADEPAT,.11),U,J)="" S Y=1 Q

 W:$D(Y) !,"***INCOMPLETE ADDRESS***"

 Q

PTHLP S DIC="^ADEFOL(",DIC(0)="EQMZ",X="??"

 S DIC("S")="I $P(^ADEFOL(Y,0),U,8)=ADETYP,$P(^(0),U,2)=ADESUB"

 D ^DIC Q

ADEMNG1   ; IHS/HQT/MJL  - DENTAL FOLLOWUP MGT PT 2 ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

LINE       WRITE $EXTRACT(ADELIN,1,40-($LENGTH(ADETITL)/2)),ADETITL,$EXTRACT(ADELIN,1,39-($LENGTH(ADETITL)/2))

           QUIT 

RESET     ;EP

 +1        SET ADETITL=" DENTAL "_$SELECT(ADEREF:"REFERRAL",ADEWAI:"WAITING LIST",ADEREC:"RECALL")_$SELECT($DATA(ADEFUNC):ADEFUNC,1:" MANAGEMENT ")

 +2        DO ^ADECLS

           DO LINE

R2        ;EP

 +1        KILL DIC

           SET DIC("A")="Select "_$PIECE(ADETITL," ",3)_" List: "

           SET DIC("S")="I $P(^ADETYP(Y,0),U,4)=ADETYP"

           SET DIC="^ADETYP("

           SET DIC(0)="AQEMZ"

           DO ^DIC

           KILL DIC

 +2        IF Y<1

               QUIT 

 +3        SET ADESUB=$PIECE(Y,U)

           SET ADESUBN=$PIECE(Y,U,2)

           SET Y=1

 +4        QUIT 

PTLOOK    ;EP

 +1        DO ^ADECLS

           DO P1

           IF Y<1

               QUIT 

           IF ADEINT

               DO P2

           SET Y=1

           QUIT 

P1         SET ADETITL=" "_ADESUBN_" "_$SELECT(ADEREF:"REFERRAL",ADEWAI:"WAITING LIST",ADEREC:"RECALL")_$SELECT($DATA(ADEFUNC):ADEFUNC,1:" MANAGEMENT ")

 +1        KILL DIC,Y,ADEPAT

           DO LINE

           READ !!,"Select Dental Patient Name: ",X:DTIME

 +2        IF '$TEST!(X="")!(X["^")

               SET Y=-1

               QUIT 

 +3        IF X["?"

               DO PTHLP

               WRITE !

               IF '$DATA(ADEMDEL)

                   WRITE " YOU MAY ADD A NEW PATIENT IF YOU WISH",!

               GOTO P1

 +4        IF $DATA(ADEMDEL)

               SET DIC("S")="I $D(^ADEFOL(""TYPE"",Y,ADETYP,ADESUB))"

 +5        SET DIC="^AUPNPAT("

           SET DIC(0)="MEZQ"

           DO ^DIC

           WRITE !

           KILL DIC

 +6        IF Y<1

               GOTO P1

 +7        SET ADEPAT=$PIECE(Y,U)

 +8        IF $DATA(^ADEUTL("ADELOCK",ADEPAT))

               WRITE !!,"PATIENT'S RECORD CURRENTLY BEING EDITED.  TRY LATER."

               HANG 2

               KILL ADEPAT,X

               DO ^ADECLS

               GOTO P1

 +9        SET ^ADEUTL("ADELOCK",ADEPAT)=""

 +10       SET ADENEWM=1

           IF $DATA(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB))

               SET ADENEWM=0

               SET ADEMDFN=$ORDER(^ADEFOL("TYPE",ADEPAT,ADETYP,ADESUB,0))

 +11       SET Y=1

           QUIT 

P2        ;EP

 +1        KILL Y

 +2       ;

 +3        SET DIE("NO^")="OUTOK"

 +4        SET DIE="^DPT("

           SET DR=".111;.114;.115;.116;.131"

           SET DA=ADEPAT

           DO ^DIE

 +5       ;

 +6        IF $DATA(Y)

               QUIT 

 +7        IF '$DATA(^DPT(ADEPAT,.11))

               SET Y=1

 +8        IF '$DATA(Y)

               FOR J=1,4,5

                   IF $PIECE(^DPT(ADEPAT,.11),U,J)=""

                       SET Y=1

                       QUIT 

 +9        IF $DATA(Y)

               WRITE !,"***INCOMPLETE ADDRESS***"

 +10       QUIT 

PTHLP      SET DIC="^ADEFOL("

           SET DIC(0)="EQMZ"

           SET X="??"

 +1        SET DIC("S")="I $P(^ADEFOL(Y,0),U,8)=ADETYP,$P(^(0),U,2)=ADESUB"

 +2        DO ^DIC

           QUIT