- ADEMP ; IHS/HQT/MJL - DENTAL FOLLOWUP OUTPUT ;08:04 PM [ 03/24/1999 9:04 AM ]
- ;;6.0;ADE;;APRIL 1999
- ;CALL AT EN TO GET OUTPUT FOR INDIVIDUAL PATIENT
- INIT ;ADEMCAT="rc" set in Calling option
- G:'$D(ADEMCAT) END
- ;------->GET TYPE - ENDO,PROS,ETC
- D TYPE G:Y<1 END S ADEMTYP=+Y,ADEMTYPN=Y(0,0)
- ;------->LETTERS OR SORTED LIST?
- D FORM G:Y<1 END
- ;------->SET SCREENS
- D SCR G:Y<1 END
- ;------->CALL DIS
- D DIS G END
- END ;------->END
- K ADEMCAT,ADEMTYP,ADEMTYPN Q
- TYPE K DIC S DIC="^ADETYP(",DIC("S")="I $P(^(0),U,4)=ADEMCAT",DIC(0)="AEQMZ",DIC("A")="Select "_$S(ADEMCAT="w":"WAITING ",ADEMCAT="rc":"RECALL",1:"REFERRAL")_" LIST: " D ^DIC K DIC
- Q
- DIBT K DIC S DIC="^DIBT(",X=ADETEM,DIC(0)="LZ",DIC("DR")="4///9002003.2"
- K DD,DO D FILE^DICN S ADETDFN=+Y K DIC
- Q
- DELDBT I '$D(^DIBT("B",ADETEM)) Q
- S DA=$O(^DIBT("B",ADETEM,0))
- S DR=".01///@",DIE="^DIBT("
- D ^DIE K DR,DA,DIE
- Q
- PRINT K DIC S DIC="^ADEFOL(",BY="["_ADETEM_"]",FR="",TO=""
- D EN1^DIP
- K DIC
- Q
- FORM S FLDS="[ADEMLST]"
- S Y=1,L=0,BY=".01",DHD=ADEMTYPN_" "_$S(ADEMCAT="w":"WAITING",ADEMCAT="rc":"RECALL",ADEMCAT="rf":"RECALL",1:"")_" LIST"
- Q
- SCR S DIS(0)="I $P(^ADEFOL(D0,0),U,2)=ADEMTYP"
- S Y=1 Q
- DIS K DIC S DIC="^ADEFOL(" S DICS="I $P(^(0),U)'=""CATEGORY"",$P(^(0),U)'=""TYPE""" D EN^DIS K DIC,DICS,DIS(0)
- Q
- EN ;EP - INTERNAL ENTRY POINT WITH ENTRY IN ^ADEFOL DEFINED AS ADEMDFN
- ; TO PRINT LETTER FOR INDIVIDUALLY SELECTED PT.
- ;ADEMDFN=19 set in calling option
- S ADETEM="ADEMP"_$J D DELDBT,DIBT
- ;------->SET DIBT NODE
- E2 S ^DIBT(ADETDFN,1,ADEMDFN)=""
- ;------->OUTPUT
- E3 G:'$D(^DIBT(ADETDFN,1)) E4
- S FLDS="[ADEMLET]"
- S DHIT="S $P(^ADEFOL(D0,0),U,6)=$E(DT,4,5)_""/""_$E(DT,6,7)_""/""_$E(DT,2,3)_"_$C(34)_" LETTER PRINTED"_$C(34)
- D PRINT
- ;------->DELETE ENTRY IN ^DIBT
- E4 D DELDBT
- ;------->END
- K ADEMDFN,ADETEM,ADETDFN Q
- ADEMP ; IHS/HQT/MJL - DENTAL FOLLOWUP OUTPUT ;08:04 PM [ 03/24/1999 9:04 AM ]
- +1 ;;6.0;ADE;;APRIL 1999
- +2 ;CALL AT EN TO GET OUTPUT FOR INDIVIDUAL PATIENT
- INIT ;ADEMCAT="rc" set in Calling option
- +1 IF '$DATA(ADEMCAT)
- GOTO END
- +2 ;------->GET TYPE - ENDO,PROS,ETC
- +3 DO TYPE
- IF Y<1
- GOTO END
- SET ADEMTYP=+Y
- SET ADEMTYPN=Y(0,0)
- +4 ;------->LETTERS OR SORTED LIST?
- +5 DO FORM
- IF Y<1
- GOTO END
- +6 ;------->SET SCREENS
- +7 DO SCR
- IF Y<1
- GOTO END
- +8 ;------->CALL DIS
- +9 DO DIS
- GOTO END
- END ;------->END
- +1 KILL ADEMCAT,ADEMTYP,ADEMTYPN
- QUIT
- TYPE KILL DIC
- SET DIC="^ADETYP("
- SET DIC("S")="I $P(^(0),U,4)=ADEMCAT"
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select "_$SELECT(ADEMCAT="w":"WAITING ",ADEMCAT="rc":"RECALL",1:"REFERRAL")_" LIST: "
- DO ^DIC
- KILL DIC
- +1 QUIT
- DIBT KILL DIC
- SET DIC="^DIBT("
- SET X=ADETEM
- SET DIC(0)="LZ"
- SET DIC("DR")="4///9002003.2"
- +1 KILL DD,DO
- DO FILE^DICN
- SET ADETDFN=+Y
- KILL DIC
- +2 QUIT
- DELDBT IF '$DATA(^DIBT("B",ADETEM))
- QUIT
- +1 SET DA=$ORDER(^DIBT("B",ADETEM,0))
- +2 SET DR=".01///@"
- SET DIE="^DIBT("
- +3 DO ^DIE
- KILL DR,DA,DIE
- +4 QUIT
- PRINT KILL DIC
- SET DIC="^ADEFOL("
- SET BY="["_ADETEM_"]"
- SET FR=""
- SET TO=""
- +1 DO EN1^DIP
- +2 KILL DIC
- +3 QUIT
- FORM SET FLDS="[ADEMLST]"
- +1 SET Y=1
- SET L=0
- SET BY=".01"
- SET DHD=ADEMTYPN_" "_$SELECT(ADEMCAT="w":"WAITING",ADEMCAT="rc":"RECALL",ADEMCAT="rf":"RECALL",1:"")_" LIST"
- +2 QUIT
- SCR SET DIS(0)="I $P(^ADEFOL(D0,0),U,2)=ADEMTYP"
- +1 SET Y=1
- QUIT
- DIS KILL DIC
- SET DIC="^ADEFOL("
- SET DICS="I $P(^(0),U)'=""CATEGORY"",$P(^(0),U)'=""TYPE"""
- DO EN^DIS
- KILL DIC,DICS,DIS(0)
- +1 QUIT
- EN ;EP - INTERNAL ENTRY POINT WITH ENTRY IN ^ADEFOL DEFINED AS ADEMDFN
- +1 ; TO PRINT LETTER FOR INDIVIDUALLY SELECTED PT.
- +2 ;ADEMDFN=19 set in calling option
- +3 SET ADETEM="ADEMP"_$JOB
- DO DELDBT
- DO DIBT
- +4 ;------->SET DIBT NODE
- E2 SET ^DIBT(ADETDFN,1,ADEMDFN)=""
- +1 ;------->OUTPUT
- E3 IF '$DATA(^DIBT(ADETDFN,1))
- GOTO E4
- +1 SET FLDS="[ADEMLET]"
- +2 SET DHIT="S $P(^ADEFOL(D0,0),U,6)=$E(DT,4,5)_""/""_$E(DT,6,7)_""/""_$E(DT,2,3)_"_$CHAR(34)_" LETTER PRINTED"_$CHAR(34)
- +3 DO PRINT
- +4 ;------->DELETE ENTRY IN ^DIBT
- E4 DO DELDBT
- +1 ;------->END
- +2 KILL ADEMDFN,ADETEM,ADETDFN
- QUIT
