ADERVW ; IHS/HQT/MJL - DENTAL CHART REVW PART 1 ; [ 03/24/1999 9:04 AM ]
;;6.0;ADE;;APRIL 1999
G EN1
START N ADEADA,ADEBRK,ADEC,ADECAT,ADECKP,ADECVD,ADEDAT,ADEDFN,ADEDLM,ADEDLT,ADEDTD,ADEDTU,ADEF,ADEFLG,ADEFO,ADEHD2,ADEHDR,ADEICL,ADEILN
N ADEMDFN,ADENDM,ADENDN,ADENFLG,ADENOD,ADENRQ,ADENSH,ADEOP,ADEPG,ADEPRT,ADEQ,ADER,ADESFC,ADESFN,ADESITE,ADESITX,ADESUB,ADESUBD,ADESVD
N ADETXT,ADETYP,ADETYPN,ADEX,ADEY
N ADECNT,ADEDES,ADEJ,ADENOT,ADEPC,ADEPRV,ADEREP,ADEV,ADENDMS
D INIT
;------->LIST FOLLOWUP, FAILED APPTS
D ^ADERVW2
;------->LIST DENTAL PROCEDURES
D ^ADERVW1
;------->CALL TURNAROUND FORM FROM HERE
D:$D(ADETUR) ^ADETUR
;------->RETURN TO CALLING ROUTINE
END ;EP
I $D(IOST)=11,'ADEPCC,$P(IOST,"-")="C" S ADEHDR="",%="END CONFIDENTIAL PATIENT DATA",$P(ADEHDR,"*",(IOM-$L(%)/2))=%,$P(ADEHDR,"*",IOM-$L(%))="" W *7,ADEHDR,!,"<>" R X:DTIME
KILL I 'ADEPCC D ^%ZISC K APCHSQIT,APCHSNPG
K ADEADA,ADEBRK,ADEC,ADECAT,ADECKP,ADECVD,ADEDAT,ADEDFN,ADEDLM,ADEDLT,ADEDTD,ADEDTU,ADEF,ADEFLG,ADEFO,ADEHD2,ADEHDR,ADEICL,ADEILN
K ADEMDFN,ADENDM,ADENDN,ADENOD,ADENRQ,ADENSH,ADEOP,ADEPG,ADEPRT,ADEQ,ADER,ADESFC,ADESFN,ADESITE,ADESITX,ADESUB,ADESUBD,ADESVD
K ADETXT,ADETYP,ADETYPN,ADEX,ADEY
K ADECNT,ADEDES,ADEJ,ADENOT,ADEPC,ADEPRV,ADEREP,ADEV,ADENDMS
Q
K ADEPCC,ADETUR,ADEZ ;*NE
;
INIT I '$D(ADEPCC) S Y=0 Q
G:'ADEPCC I2
;
S ADEPAT=APCHSPAT
S ADECVD=APCHSCVD,ADECKP=APCHSCKP,ADEBRK=APCHSBRK,ADEDLM=APCHSDLM,ADENDM=APCHSNDM
;S ADEPRT="S APCHSNRQ=ADENRQ,APCHSTXT=ADETXT,APCHSICL=ADEICL D PRTTXT^APCHSUTL K APCHSNRQ,APCHSTXT,APCHSICL"
S ADEPRT="D PRTTXT^ADERVW0"
;S ADESITX="S APCHSITE=ADESITE D GETSITE^APCHSUTL S ADENSH=APCHSNSH K APCHSITE,APCHSNFL,APCHSNAB,APCHSNSH"
S ADESITX="D GETSITE^ADERVW0"
S Y=1
Q
I2 ;EP
S ADEPG=0
S %="CONFIDENTIAL PATIENT DATA",$P(ADEHDR,"*",(IOM-$L(%)/2))=%,$P(ADEHDR,"*",IOM-$L(%))=""
S ADEPRT="D PRTTXT^ADERVW0"
S ADESITX="D GETSITE^ADERVW0"
S ADECKP="Q:$D(APCHSQIT) S APCHSNPG=0 I $Y>(IOSL-2) "
S ADEBRK=""
I $P(IOST,"-")="C" S ADECKP=ADECKP_"W *7,""<>"" R X:DTIME S:'$T X=U W *13 S:X[U APCHSQIT="""" I '$D(APCHSQIT) "
S ADECKP=ADECKP_"W @IOF D HEADER^ADERVW0 S APCHSNPG=1"
I $D(DUZ(2)),DUZ(2),$D(^ADEPARAM(DUZ(2),0)) S ADEDLM=$P(^ADEPARAM(DUZ(2),0),U,9) S ADEDLM=$S(ADEDLM["D":ADEDLM,ADEDLM["M":ADEDLM*30,ADEDLM["Y":ADEDLM*365,1:5*365)
S:'$D(ADEDLM) ADEDLM=5*365
S X1=DT,X2=-ADEDLM D C^%DTC S ADEDLM=9999999-X K X1,X2
S:$D(ADELAST) ADENDM=1
I '$D(ADENDM),$D(DUZ(2)),DUZ(2),$D(^ADEPARAM(DUZ(2),0)) S ADENDM=$P(^ADEPARAM(DUZ(2),0),U,8) S:'ADENDM ADENDM=10
S:'$D(ADENDM) ADENDM=10
S ADECVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
U IO W @IOF D HEADER^ADERVW0 S APCHSNPG=1
S Y=1 Q
QUE S ZTRTN="START^ADERVW",ZTDESC="DENTAL PATIENT INQUIRE",ZTSAVE("ADEPAT")="",ZTSAVE("ADEPCC")="" D ^%ZTLOAD Q
;
PCC ;PEP
;Published Entry point from PCC HEALTH SUMMARY routines
N ADEPCC,ADEPAT
S ADEPAT=APCHSPAT
S ADEPCC=1
D START
Q
;
EN1 ;EP -Enter here to prompt for device, patient
N ADEPCC,ADEPAT
S ADEPCC=0
K DIC S DIC="^AUPNPAT(",DIC(0)="AEQMZ" D ^DIC
I Y<1 G EN1END
S ADEPAT=+Y
S %ZIS="Q" D ^%ZIS
I POP G EN1END
;FHL 9/9/98 I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTSK) !,"REQUEST QUEUED!" G EN1END
I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTQUEUED) !,"REQUEST QUEUED!" G EN1END
D START
EN1END Q
EN2 ;EP - Enter here with ADETMP defined as ADEPAT, device will be home
N ADEPCC
S ADEPCC=0
S IOP=0 D ^%ZIS
D START
Q
EN3 ;EP - Enter here with ADEPAT and device defined. FM entry point
N ADEPCC
S ADEPCC=0
D START
Q
ADERVW ; IHS/HQT/MJL - DENTAL CHART REVW PART 1 ; [ 03/24/1999 9:04 AM ]
+1 ;;6.0;ADE;;APRIL 1999
+2 GOTO EN1
START NEW ADEADA,ADEBRK,ADEC,ADECAT,ADECKP,ADECVD,ADEDAT,ADEDFN,ADEDLM,ADEDLT,ADEDTD,ADEDTU,ADEF,ADEFLG,ADEFO,ADEHD2,ADEHDR,ADEICL,ADEILN
+1 NEW ADEMDFN,ADENDM,ADENDN,ADENFLG,ADENOD,ADENRQ,ADENSH,ADEOP,ADEPG,ADEPRT,ADEQ,ADER,ADESFC,ADESFN,ADESITE,ADESITX,ADESUB,ADESUBD,ADESVD
+2 NEW ADETXT,ADETYP,ADETYPN,ADEX,ADEY
+3 NEW ADECNT,ADEDES,ADEJ,ADENOT,ADEPC,ADEPRV,ADEREP,ADEV,ADENDMS
+4 DO INIT
+5 ;------->LIST FOLLOWUP, FAILED APPTS
+6 DO ^ADERVW2
+7 ;------->LIST DENTAL PROCEDURES
+8 DO ^ADERVW1
+9 ;------->CALL TURNAROUND FORM FROM HERE
+10 IF $DATA(ADETUR)
DO ^ADETUR
+11 ;------->RETURN TO CALLING ROUTINE
END ;EP
+1 IF $DATA(IOST)=11
IF 'ADEPCC
IF $PIECE(IOST,"-")="C"
SET ADEHDR=""
SET %="END CONFIDENTIAL PATIENT DATA"
SET $PIECE(ADEHDR,"*",(IOM-$LENGTH(%)/2))=%
SET $PIECE(ADEHDR,"*",IOM-$LENGTH(%))=""
WRITE *7,ADEHDR,!,"<>"
READ X:DTIME
KILL IF 'ADEPCC
DO ^%ZISC
KILL APCHSQIT,APCHSNPG
+1 KILL ADEADA,ADEBRK,ADEC,ADECAT,ADECKP,ADECVD,ADEDAT,ADEDFN,ADEDLM,ADEDLT,ADEDTD,ADEDTU,ADEF,ADEFLG,ADEFO,ADEHD2,ADEHDR,ADEICL,ADEILN
+2 KILL ADEMDFN,ADENDM,ADENDN,ADENOD,ADENRQ,ADENSH,ADEOP,ADEPG,ADEPRT,ADEQ,ADER,ADESFC,ADESFN,ADESITE,ADESITX,ADESUB,ADESUBD,ADESVD
+3 KILL ADETXT,ADETYP,ADETYPN,ADEX,ADEY
+4 KILL ADECNT,ADEDES,ADEJ,ADENOT,ADEPC,ADEPRV,ADEREP,ADEV,ADENDMS
+5 QUIT
+6 ;*NE
KILL ADEPCC,ADETUR,ADEZ
+7 ;
INIT IF '$DATA(ADEPCC)
SET Y=0
QUIT
+1 IF 'ADEPCC
GOTO I2
+2 ;
+3 SET ADEPAT=APCHSPAT
+4 SET ADECVD=APCHSCVD
SET ADECKP=APCHSCKP
SET ADEBRK=APCHSBRK
SET ADEDLM=APCHSDLM
SET ADENDM=APCHSNDM
+5 ;S ADEPRT="S APCHSNRQ=ADENRQ,APCHSTXT=ADETXT,APCHSICL=ADEICL D PRTTXT^APCHSUTL K APCHSNRQ,APCHSTXT,APCHSICL"
+6 SET ADEPRT="D PRTTXT^ADERVW0"
+7 ;S ADESITX="S APCHSITE=ADESITE D GETSITE^APCHSUTL S ADENSH=APCHSNSH K APCHSITE,APCHSNFL,APCHSNAB,APCHSNSH"
+8 SET ADESITX="D GETSITE^ADERVW0"
+9 SET Y=1
+10 QUIT
I2 ;EP
+1 SET ADEPG=0
+2 SET %="CONFIDENTIAL PATIENT DATA"
SET $PIECE(ADEHDR,"*",(IOM-$LENGTH(%)/2))=%
SET $PIECE(ADEHDR,"*",IOM-$LENGTH(%))=""
+3 SET ADEPRT="D PRTTXT^ADERVW0"
+4 SET ADESITX="D GETSITE^ADERVW0"
+5 SET ADECKP="Q:$D(APCHSQIT) S APCHSNPG=0 I $Y>(IOSL-2) "
+6 SET ADEBRK=""
+7 IF $PIECE(IOST,"-")="C"
SET ADECKP=ADECKP_"W *7,""<>"" R X:DTIME S:'$T X=U W *13 S:X[U APCHSQIT="""" I '$D(APCHSQIT) "
+8 SET ADECKP=ADECKP_"W @IOF D HEADER^ADERVW0 S APCHSNPG=1"
+9 IF $DATA(DUZ(2))
IF DUZ(2)
IF $DATA(^ADEPARAM(DUZ(2),0))
SET ADEDLM=$PIECE(^ADEPARAM(DUZ(2),0),U,9)
SET ADEDLM=$SELECT(ADEDLM["D":ADEDLM,ADEDLM["M":ADEDLM*30,ADEDLM["Y":ADEDLM*365,1:5*365)
+10 IF '$DATA(ADEDLM)
SET ADEDLM=5*365
+11 SET X1=DT
SET X2=-ADEDLM
DO C^%DTC
SET ADEDLM=9999999-X
KILL X1,X2
+12 IF $DATA(ADELAST)
SET ADENDM=1
+13 IF '$DATA(ADENDM)
IF $DATA(DUZ(2))
IF DUZ(2)
IF $DATA(^ADEPARAM(DUZ(2),0))
SET ADENDM=$PIECE(^ADEPARAM(DUZ(2),0),U,8)
IF 'ADENDM
SET ADENDM=10
+14 IF '$DATA(ADENDM)
SET ADENDM=10
+15 SET ADECVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$E(Y,6,7)_""/""_$E(Y,2,3)"
+16 USE IO
WRITE @IOF
DO HEADER^ADERVW0
SET APCHSNPG=1
+17 SET Y=1
QUIT
QUE SET ZTRTN="START^ADERVW"
SET ZTDESC="DENTAL PATIENT INQUIRE"
SET ZTSAVE("ADEPAT")=""
SET ZTSAVE("ADEPCC")=""
DO ^%ZTLOAD
QUIT
+1 ;
PCC ;PEP
+1 ;Published Entry point from PCC HEALTH SUMMARY routines
+2 NEW ADEPCC,ADEPAT
+3 SET ADEPAT=APCHSPAT
+4 SET ADEPCC=1
+5 DO START
+6 QUIT
+7 ;
EN1 ;EP -Enter here to prompt for device, patient
+1 NEW ADEPCC,ADEPAT
+2 SET ADEPCC=0
+3 KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="AEQMZ"
DO ^DIC
+4 IF Y<1
GOTO EN1END
+5 SET ADEPAT=+Y
+6 SET %ZIS="Q"
DO ^%ZIS
+7 IF POP
GOTO EN1END
+8 ;FHL 9/9/98 I $D(IO("Q")) K IO("Q") D QUE W:$D(ZTSK) !,"REQUEST QUEUED!" G EN1END
+9 IF $DATA(IO("Q"))
KILL IO("Q")
DO QUE
IF $DATA(ZTQUEUED)
WRITE !,"REQUEST QUEUED!"
GOTO EN1END
+10 DO START
EN1END QUIT
EN2 ;EP - Enter here with ADETMP defined as ADEPAT, device will be home
+1 NEW ADEPCC
+2 SET ADEPCC=0
+3 SET IOP=0
DO ^%ZIS
+4 DO START
+5 QUIT
EN3 ;EP - Enter here with ADEPAT and device defined. FM entry point
+1 NEW ADEPCC
+2 SET ADEPCC=0
+3 DO START
+4 QUIT
