- ADEMPRT ; IHS/HQT/MJL - FOLLOWUP GROUP OUTPUT ;07:02 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- ;------->INIT
- K DIS
- ;------->GET SEARCH TEMPLATE
- D TEM G:Y<1 END
- ;------->GET OUTPUT FORM
- D FORM G:'Y END
- ;------->GET HEADER
- I '$D(FLDS) D DHD G:'Y END
- I $D(FLDS),FLDS'["LET" D DHD G:'Y END
- ;------->CALL DIP
- D DIP
- ;------->END
- END K ADEMDFN,ADEPAT,ADEQ,ADESUB,ADETMD,ADEDHIT Q
- TEM K DIC S DIC="^DIBT(",DIC("A")="Select SEARCH TEMPLATE: ",DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,4)=9002003.2,$P(^(0),U,5)=DUZ,$D(^(""DIS""))" D ^DIC K DIC Q:Y<1
- S ADETMD=+Y,BY="["_Y(0,0)_"],.01",FR="",TO=""
- I '$D(^DIBT(ADETMD,1)) W !,"***NO DATA IN TEMPLATE***" S Y=0
- Q
- DIP S DIC="^ADEFOL(" D EN1^DIP Q
- FORM W !!?5,"OUTPUT FORMAT:",!,?10,"1. Letters",!,?10,"2. Standard Sorted List",!,?10,"3. Customized List",!,?5,"Select FORMAT (1-3): "
- R FLDS:DTIME S:'$T FLDS=""
- I FLDS=""!(FLDS["^") S Y=0 Q
- S FLDS=$S(FLDS=1:"[ADEMLET]",FLDS=2:"[ADEMLST]",FLDS=3:"USER",1:"")
- I FLDS="" W *7," ??" G FORM
- S Y=1,L=0
- D DHIT K:FLDS="USER" FLDS Q
- Q
- DHD S Y=0 W !,"HEADING: DENTAL FOLLOWUP LIST// "
- R DHD:DTIME I '$T S DHD="^" Q
- Q:DHD["^"
- I DHD["?" W !!,?5,"Enter the Report Heading." G DHD
- S:DHD="" DHD="DENTAL FOLLOWUP LIST"
- S Y=1 Q
- DHIT S Y=0 K DHIT
- I FLDS="[ADEMLET]" S ADEDHIT=" LETTER PRINTED" G DHIT1
- W !,"ACTION TO BE TAKEN: " R ADEDHIT:DTIME S:'$T ADEDHIT="^"
- Q:ADEDHIT="^"
- I $E(ADEDHIT,1,2)["?" W !,?5,"Enter the Action to be Taken based on the list you are about to print out.",!?5,"or press `RETURN' to skip." G DHIT
- I ADEDHIT="" S Y=1 Q
- I ADEDHIT="@" S DHIT="S $P(^ADEFOL(D0,0),U,6)=""""",Y=1 Q
- S ADEDHIT=" "_ADEDHIT
- S X=ADEDHIT S:X["^" X="^" X $P(^DD(9002003.2,5,0),U,5,99) I '$D(X) W *7,!?5,"ANSWER MUST BE 3-30 CHARACTERS AND NOT CONTAIN `^'" G DHIT
- DHIT1 S DHIT="S $P(^ADEFOL(D0,0),U,6)=$E(DT,4,5)_""/""_$E(DT,6,7)_""/""_$E(DT,2,3)_"_$C(34)_ADEDHIT_$C(34)
- S Y=1 K X Q
- ADEMPRT ; IHS/HQT/MJL - FOLLOWUP GROUP OUTPUT ;07:02 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 ;------->INIT
- +3 KILL DIS
- +4 ;------->GET SEARCH TEMPLATE
- +5 DO TEM
- IF Y<1
- GOTO END
- +6 ;------->GET OUTPUT FORM
- +7 DO FORM
- IF 'Y
- GOTO END
- +8 ;------->GET HEADER
- +9 IF '$DATA(FLDS)
- DO DHD
- IF 'Y
- GOTO END
- +10 IF $DATA(FLDS)
- IF FLDS'["LET"
- DO DHD
- IF 'Y
- GOTO END
- +11 ;------->CALL DIP
- +12 DO DIP
- +13 ;------->END
- END KILL ADEMDFN,ADEPAT,ADEQ,ADESUB,ADETMD,ADEDHIT
- QUIT
- TEM KILL DIC
- SET DIC="^DIBT("
- SET DIC("A")="Select SEARCH TEMPLATE: "
- SET DIC(0)="AEQMZ"
- SET DIC("S")="I $P(^(0),U,4)=9002003.2,$P(^(0),U,5)=DUZ,$D(^(""DIS""))"
- DO ^DIC
- KILL DIC
- IF Y<1
- QUIT
- +1 SET ADETMD=+Y
- SET BY="["_Y(0,0)_"],.01"
- SET FR=""
- SET TO=""
- +2 IF '$DATA(^DIBT(ADETMD,1))
- WRITE !,"***NO DATA IN TEMPLATE***"
- SET Y=0
- +3 QUIT
- DIP SET DIC="^ADEFOL("
- DO EN1^DIP
- QUIT
- FORM WRITE !!?5,"OUTPUT FORMAT:",!,?10,"1. Letters",!,?10,"2. Standard Sorted List",!,?10,"3. Customized List",!,?5,"Select FORMAT (1-3): "
- +1 READ FLDS:DTIME
- IF '$TEST
- SET FLDS=""
- +2 IF FLDS=""!(FLDS["^")
- SET Y=0
- QUIT
- +3 SET FLDS=$SELECT(FLDS=1:"[ADEMLET]",FLDS=2:"[ADEMLST]",FLDS=3:"USER",1:"")
- +4 IF FLDS=""
- WRITE *7," ??"
- GOTO FORM
- +5 SET Y=1
- SET L=0
- +6 DO DHIT
- IF FLDS="USER"
- KILL FLDS
- QUIT
- +7 QUIT
- DHD SET Y=0
- WRITE !,"HEADING: DENTAL FOLLOWUP LIST// "
- +1 READ DHD:DTIME
- IF '$TEST
- SET DHD="^"
- QUIT
- +2 IF DHD["^"
- QUIT
- +3 IF DHD["?"
- WRITE !!,?5,"Enter the Report Heading."
- GOTO DHD
- +4 IF DHD=""
- SET DHD="DENTAL FOLLOWUP LIST"
- +5 SET Y=1
- QUIT
- DHIT SET Y=0
- KILL DHIT
- +1 IF FLDS="[ADEMLET]"
- SET ADEDHIT=" LETTER PRINTED"
- GOTO DHIT1
- +2 WRITE !,"ACTION TO BE TAKEN: "
- READ ADEDHIT:DTIME
- IF '$TEST
- SET ADEDHIT="^"
- +3 IF ADEDHIT="^"
- QUIT
- +4 IF $EXTRACT(ADEDHIT,1,2)["?"
- WRITE !,?5,"Enter the Action to be Taken based on the list you are about to print out.",!?5,"or press `RETURN' to skip."
- GOTO DHIT
- +5 IF ADEDHIT=""
- SET Y=1
- QUIT
- +6 IF ADEDHIT="@"
- SET DHIT="S $P(^ADEFOL(D0,0),U,6)="""""
- SET Y=1
- QUIT
- +7 SET ADEDHIT=" "_ADEDHIT
- +8 SET X=ADEDHIT
- IF X["^"
- SET X="^"
- XECUTE $PIECE(^DD(9002003.2,5,0),U,5,99)
- IF '$DATA(X)
- WRITE *7,!?5,"ANSWER MUST BE 3-30 CHARACTERS AND NOT CONTAIN `^'"
- GOTO DHIT
- DHIT1 SET DHIT="S $P(^ADEFOL(D0,0),U,6)=$E(DT,4,5)_""/""_$E(DT,6,7)_""/""_$E(DT,2,3)_"_$CHAR(34)_ADEDHIT_$CHAR(34)
- +1 SET Y=1
- KILL X
- QUIT
