DENTPEX ;ISC2/HCD-Inpatients needing Dental Exam Report ;10/23/90 14:35 ;
;;VERSION 1.2;;**7,11**;
S Z4="" G:'$D(^DENT(225,0)) W I $P(^(0),U,4)=1 S X=$P(^(0),U,3) I $D(^DENT(225,X,0)) S DENTSTA=$P(^(0),U) G D
S DIC="^DENT(225,",DIC(0)="AEMQ" D ^DIC G EXIT1:Y<0 S DENTSTA=$P(Y,U,2)
D S %ZIS="MQ" K IO("Q") D ^%ZIS G EXIT1:IO=""
I $D(IO("Q")) S ZTRTN="QUE^DENTPEX",ZTSAVE("DENTSTA")="",ZTSAVE("U")="",ZTSAVE("Z4")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G CLOSE
QUE U IO D RET G EXIT2:'$D(^UTILITY($J,"DENTTR")) D PR1,PR
I Z4'[U,'$D(ZTSK),IO=IO(0) R !!,"Press return to continue, uparrow (^) to exit: ",X:DTIME
G CLOSE
RET D NOW^%DTC S Y=X X ^DD("DD") S DATE=Y K ^UTILITY($J,"DENTTR")
S X1="" F DENTI=0:0 S X1=$O(^DPT("CN",X1)) Q:X1="" S DENT="" F J=1:1 S DENT=$O(^DPT("CN",X1,DENT)) Q:DENT="" I $D(^DPT(DENT,0)) D WRD
Q
WRD S DENTX2=0,DFN=DENT D INP^VADPT Q:'VAIN(1)!('VAIN(7)) D DEM^VADPT S:VAIN(5)="" VAIN(5)=" " Q:VADM(2)']"" S DENTDX=VAIN(9)
I '$D(^DENT(221,"D",$P(VADM(2),U))) S DENTX="" G SET
S DENTX=1,X2="" F K=0:0 S X2=$O(^DENT(221,"D",$P(VADM(2),U),X2)) Q:X2="" D:$D(^DENT(221,X2,0)) WRD1 Q:$D(DENTX1)
SET S:('$D(DENTX1)&('DENTX))!(DENTX2) ^UTILITY($J,"DENTTR",$P(VAIN(4),U,2),VAIN(5),VADM(1))=$P(VADM(2),U)_U_DENTDX K DENTX1 Q
WRD1 S DENTTD=^(0) I $P(DENTTD,"^",40)=DENTSTA,$P(VAIN(7),U)'>+DENTTD S DENTX2=0 S:$P(DENTTD,"^",7)="" DENTX="" S:$P(DENTTD,"^",7)'="" DENTX1=1 Q
I $P(DENTTD,"^",40)=DENTSTA,$P(VAIN(7),U)>+DENTTD S DENTX2=1
Q
PR S (DENTNB,X)="" F I=0:1 S X=$O(^UTILITY($J,"DENTTR",X)) Q:X="" D:I&($Y>(IOSL-3)) HOLD1 Q:Z4[U S X1="" F J=0:0 S X1=$O(^UTILITY($J,"DENTTR",X,X1)) Q:X1="" S DENTNM="" F K=0:0 S DENTNM=$O(^UTILITY($J,"DENTTR",X,X1,DENTNM)) Q:DENTNM="" D PR2
Q
PR2 S Z=^UTILITY($J,"DENTTR",X,X1,DENTNM),DENTSSN=$P(Z,U),DENTDX=$P(Z,U,2),DENTNB=DENTNB+1
D:$Y>(IOSL-3) HOLD1 Q:Z4[U W !,$J(DENTNB,3),?5,$E(X,1,10),?17,$E(X1,1,10),?29,$E(DENTNM,1,24),?54,DENTSSN,?65,$E(DENTDX,1,15),! Q
PR1 S Z1="Veterans Administration Medical Center",Z2="Dental Service -- Station Number "_DENTSTA,Z3="Inpatients Needing Dental Exams for "_DATE
W @IOF,$C(13),?(80-$L(Z1)/2),Z1,!,?(80-$L(Z2)/2),Z2,!,?(80-$L(Z3)/2),Z3,!!
W !,?5,"Ward",?17,"Room-Bed",?29,"Patient Name",?54,"SSN",?65,"Diagnosis",!,?5,"----",?17,"--------",?29,"------------",?54,"---------",?65,"---------" Q
HOLD1 D HOLD D:Z4'[U PR1 Q
HOLD Q:$D(ZTSK)!(IO'=IO(0)) S Z4="" R !,"Press return to continue, uparrow (^) to exit: ",Z4:DTIME Q
W W !!,"Stations have not been entered in the Dental Site Parameter file.",!,"You must enter a station before you can use this option." G EXIT1
EXIT2 W !!,"There are no examinations for station "_DENTSTA_" that need to be done today.",!
CLOSE X ^%ZIS("C")
EXIT1 K %,DATE,DENTDX,DENTI,DENTNB,DENTNM,DENTSTA,DENTSSN,DENTTD,DENTX,DENTX1,DENTX2,DIC,I,J,K,VADM,VAIN,X,X1,X2,Z,Z1,Z2,Z3,Z4,Y,^UTILITY($J,"DENTTR") K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTPEX 2904 printed Dec 13, 2024@01:46:44 Page 2
DENTPEX ;ISC2/HCD-Inpatients needing Dental Exam Report ;10/23/90 14:35 ;
+1 ;;VERSION 1.2;;**7,11**;
+2 SET Z4=""
if '$DATA(^DENT(225,0))
GOTO W
IF $PIECE(^(0),U,4)=1
SET X=$PIECE(^(0),U,3)
IF $DATA(^DENT(225,X,0))
SET DENTSTA=$PIECE(^(0),U)
GOTO D
+3 SET DIC="^DENT(225,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y<0
GOTO EXIT1
SET DENTSTA=$PIECE(Y,U,2)
D SET %ZIS="MQ"
KILL IO("Q")
DO ^%ZIS
if IO=""
GOTO EXIT1
+1 IF $DATA(IO("Q"))
SET ZTRTN="QUE^DENTPEX"
SET ZTSAVE("DENTSTA")=""
SET ZTSAVE("U")=""
SET ZTSAVE("Z4")=""
DO ^%ZTLOAD
KILL ZTSK,ZTRTN,ZTSAVE
GOTO CLOSE
QUE USE IO
DO RET
if '$DATA(^UTILITY($JOB,"DENTTR"))
GOTO EXIT2
DO PR1
DO PR
+1 IF Z4'[U
IF '$DATA(ZTSK)
IF IO=IO(0)
READ !!,"Press return to continue, uparrow (^) to exit: ",X:DTIME
+2 GOTO CLOSE
RET DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET DATE=Y
KILL ^UTILITY($JOB,"DENTTR")
+1 SET X1=""
FOR DENTI=0:0
SET X1=$ORDER(^DPT("CN",X1))
if X1=""
QUIT
SET DENT=""
FOR J=1:1
SET DENT=$ORDER(^DPT("CN",X1,DENT))
if DENT=""
QUIT
IF $DATA(^DPT(DENT,0))
DO WRD
+2 QUIT
WRD SET DENTX2=0
SET DFN=DENT
DO INP^VADPT
if 'VAIN(1)!('VAIN(7))
QUIT
DO DEM^VADPT
if VAIN(5)=""
SET VAIN(5)=" "
if VADM(2)']""
QUIT
SET DENTDX=VAIN(9)
+1 IF '$DATA(^DENT(221,"D",$PIECE(VADM(2),U)))
SET DENTX=""
GOTO SET
+2 SET DENTX=1
SET X2=""
FOR K=0:0
SET X2=$ORDER(^DENT(221,"D",$PIECE(VADM(2),U),X2))
if X2=""
QUIT
if $DATA(^DENT(221,X2,0))
DO WRD1
if $DATA(DENTX1)
QUIT
SET if ('$DATA(DENTX1)&('DENTX))!(DENTX2)
SET ^UTILITY($JOB,"DENTTR",$PIECE(VAIN(4),U,2),VAIN(5),VADM(1))=$PIECE(VADM(2),U)_U_DENTDX
KILL DENTX1
QUIT
WRD1 SET DENTTD=^(0)
IF $PIECE(DENTTD,"^",40)=DENTSTA
IF $PIECE(VAIN(7),U)'>+DENTTD
SET DENTX2=0
if $PIECE(DENTTD,"^",7)=""
SET DENTX=""
if $PIECE(DENTTD,"^",7)'=""
SET DENTX1=1
QUIT
+1 IF $PIECE(DENTTD,"^",40)=DENTSTA
IF $PIECE(VAIN(7),U)>+DENTTD
SET DENTX2=1
+2 QUIT
PR SET (DENTNB,X)=""
FOR I=0:1
SET X=$ORDER(^UTILITY($JOB,"DENTTR",X))
if X=""
QUIT
if I&($Y>(IOSL-3))
DO HOLD1
if Z4[U
QUIT
SET X1=""
FOR J=0:0
SET X1=$ORDER(^UTILITY($JOB,"DENTTR",X,X1))
if X1=""
QUIT
SET DENTNM=""
FOR K=0:0
SET DENTNM=$ORDER(^UTILITY($JOB,"DENTTR",X,X1,DENTNM))
if DENTNM=""
QUIT
DO PR2
+1 QUIT
PR2 SET Z=^UTILITY($JOB,"DENTTR",X,X1,DENTNM)
SET DENTSSN=$PIECE(Z,U)
SET DENTDX=$PIECE(Z,U,2)
SET DENTNB=DENTNB+1
+1 if $Y>(IOSL-3)
DO HOLD1
if Z4[U
QUIT
WRITE !,$JUSTIFY(DENTNB,3),?5,$EXTRACT(X,1,10),?17,$EXTRACT(X1,1,10),?29,$EXTRACT(DENTNM,1,24),?54,DENTSSN,?65,$EXTRACT(DENTDX,1,15),!
QUIT
PR1 SET Z1="Veterans Administration Medical Center"
SET Z2="Dental Service -- Station Number "_DENTSTA
SET Z3="Inpatients Needing Dental Exams for "_DATE
+1 WRITE @IOF,$CHAR(13),?(80-$LENGTH(Z1)/2),Z1,!,?(80-$LENGTH(Z2)/2),Z2,!,?(80-$LENGTH(Z3)/2),Z3,!!
+2 WRITE !,?5,"Ward",?17,"Room-Bed",?29,"Patient Name",?54,"SSN",?65,"Diagnosis",!,?5,"----",?17,"--------",?29,"------------",?54,"---------",?65,"---------"
QUIT
HOLD1 DO HOLD
if Z4'[U
DO PR1
QUIT
HOLD if $DATA(ZTSK)!(IO'=IO(0))
QUIT
SET Z4=""
READ !,"Press return to continue, uparrow (^) to exit: ",Z4:DTIME
QUIT
W WRITE !!,"Stations have not been entered in the Dental Site Parameter file.",!,"You must enter a station before you can use this option."
GOTO EXIT1
EXIT2 WRITE !!,"There are no examinations for station "_DENTSTA_" that need to be done today.",!
CLOSE XECUTE ^%ZIS("C")
EXIT1 KILL %,DATE,DENTDX,DENTI,DENTNB,DENTNM,DENTSTA,DENTSSN,DENTTD,DENTX,DENTX1,DENTX2,DIC,I,J,K,VADM,VAIN,X,X1,X2,Z,Z1,Z2,Z3,Z4,Y,^UTILITY($JOB,"DENTTR")
if $DATA(ZTSK)
KILL ^%ZTSK(ZTSK),ZTSK
QUIT
