- 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
