- DENTCPM ;ISC2/HCD,JEC-DENTAL CRITICAL PATH APPT. SCHED. AID (CON'T) ; 12/5/88 10:43 AM ;
- ;;VERSION 1.2;;**11**;
- ENTER W !!,"Would you like instructions" S %=2 D YN^DICN D:%=0 Q G ENTER:%=0,EXIT:%<0 I %=1 D INST
- S DIC="^DENT(220,",DIC(0)="AELQM",DIC("DR")="" D ^DIC G EXIT:Y<1 S DIE=DIC,DA=+Y,DR="[DENTCPMEDT]" D ^DIE K DIC("DR") G DENTAN:'$D(D1)
- I $D(^DENT(220,DA,9,D1,0)) W:$P(^(0),U,2)="Y" !!!,?5,"***** MAKE SURE PATIENT HAS Rx *****"
- DENTAN W !!,"Enter another appointment" S %=1 D YN^DICN D:%=0 Q1 G DENTAN:%=0,ENTER:%=1,EXIT
- PRINT S DIC="^DENT(220,",DIC(0)="AEQM" D ^DIC G EXIT:Y<0 S D0=+Y
- I '$D(^DENT(220,D0,9,0)) W !,"Sorry, no appointments have been entered for this patient.",! G DENTPA
- S DIC="^DENT(220,D0,9,",DIC(0)="AEMQ" D ^DIC G DENTPA:Y<0 S D1=+Y
- S %ZIS="MQ" K IO("Q") D ^%ZIS G DENTPA:IO=""
- I $D(IO("Q")) S ZTRTN="QUE^DENTCPM",ZTSAVE("U")="",ZTSAVE("D0")="",ZTSAVE("D1")="" D ^%ZTLOAD K ZTSK,ZTRTN,ZTSAVE G DENTPA
- QUE U IO
- W @IOF,!,?26,"DENTAL APPOINTMENT SCHEDULE"
- S DFN=D0 D DEM^VADPT I VAERR=0 S DENTNM=VADM(1),DENTSSN=$P(VADM(2),"^")
- I $D(^DENT(220,D0,9,D1,0)) S L=^(0),Y=$P(L,U,17),DENTRX=$P(L,U,2),L=$P(L,U,3,16)
- F I=1:1:14 S L(I)=$P(L,U,I)
- W !!,"PATIENT: " W:$D(DENTNM) DENTNM W ?39,"SSN: " W:$D(DENTSSN) DENTSSN X ^DD("DD") W ?55,"DATE ENTERED: ",Y,! F I=1:1:80 W "_"
- W !,"APPOINTMENTS",?30,1,?40,1,?50,2,?60,2,?70,3,?76,3
- W !,?11 F I=1:1:33 W ?($X+1),$S(I>9:$E(I,2),1:I)
- W ! F I=1:1:80 W "-"
- W !,"ITEM PROV",!
- S DENTX="PROPH^^PERIO^^ENDO^^REST^^SURG^^C&B^^PROS"
- F I=5,7,9,1,3,11,13 I L(I) W !,$P(DENTX,U,I) W:L(I+1) ?7,$P(^DENT(220.5,L(I+1),0),U,2) S I1=$S(I=3:12+(2*L(1)),I=11:12+((L(1)+L(3))*2),I=13:12+((L(1)+L(3)+L(11))*2),1:12),DENTL=$S(I=5!(I=7)!(I=9):"+ ",1:"* ") F A=1:1:L(I) W ?I1,DENTL
- S DENTRX=$S(DENTRX="Y":"will",DENTRX="N":"won't",1:"may") W !!!,"The patient "_DENTRX_" be receiving MEDICATION prior to treatment.",! G:$D(ZTSK) EXIT
- DENTPA W !!,"Print another Appointment Schedule" S %=2 D YN^DICN D:%=0 Q2 G DENTPA:%=0 I %=1 G PRINT
- EXIT X ^%ZIS("C") K %,A,DA,DENTDTE,DENTL,DENTNM,D0,DENTRX,DENTSSN,DENTX,DIC,DIE,DR,G,H,I,I1,L,X,Y,Z K:$D(ZTSK) ^%ZTSK(ZTSK),ZTSK Q
- INST W !!!,"This module provides an optimized appointment schedule for individual",!,"patients, based on indicated procedures."
- W !,"General questions such as the patient's name and appointment date are asked",!,"first, then the number of appointments necessary for each procedure and"
- W !,"the provider's ID are asked. Additional help is available by entering",!,"a question mark during any entry.",! Q
- Q W !!,"Enter a 'Y' for 'Yes' if you wish to see additional instructions on how to use",!,"this scheduling aid. Press return if you do not want additional instructions.",!,"Enter an uparrow (^) to exit this option entirely." Q
- Q1 W !!,"Press return if you want to enter another appointment for a patient.",!,"Enter 'N' for 'No' if you do not want to enter another appointment",!,"and wish to exit this option." Q
- Q2 W !!,"Enter a 'Y' for 'Yes' if you wish to print an appointment schedule",!,"for another patient or press return to exit this option." Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTCPM 3119 printed Mar 13, 2025@20:50:44 Page 2
- DENTCPM ;ISC2/HCD,JEC-DENTAL CRITICAL PATH APPT. SCHED. AID (CON'T) ; 12/5/88 10:43 AM ;
- +1 ;;VERSION 1.2;;**11**;
- ENTER WRITE !!,"Would you like instructions"
- SET %=2
- DO YN^DICN
- if %=0
- DO Q
- if %=0
- GOTO ENTER
- if %<0
- GOTO EXIT
- IF %=1
- DO INST
- +1 SET DIC="^DENT(220,"
- SET DIC(0)="AELQM"
- SET DIC("DR")=""
- DO ^DIC
- if Y<1
- GOTO EXIT
- SET DIE=DIC
- SET DA=+Y
- SET DR="[DENTCPMEDT]"
- DO ^DIE
- KILL DIC("DR")
- if '$DATA(D1)
- GOTO DENTAN
- +2 IF $DATA(^DENT(220,DA,9,D1,0))
- if $PIECE(^(0),U,2)="Y"
- WRITE !!!,?5,"***** MAKE SURE PATIENT HAS Rx *****"
- DENTAN WRITE !!,"Enter another appointment"
- SET %=1
- DO YN^DICN
- if %=0
- DO Q1
- if %=0
- GOTO DENTAN
- if %=1
- GOTO ENTER
- GOTO EXIT
- PRINT SET DIC="^DENT(220,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y<0
- GOTO EXIT
- SET D0=+Y
- +1 IF '$DATA(^DENT(220,D0,9,0))
- WRITE !,"Sorry, no appointments have been entered for this patient.",!
- GOTO DENTPA
- +2 SET DIC="^DENT(220,D0,9,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- if Y<0
- GOTO DENTPA
- SET D1=+Y
- +3 SET %ZIS="MQ"
- KILL IO("Q")
- DO ^%ZIS
- if IO=""
- GOTO DENTPA
- +4 IF $DATA(IO("Q"))
- SET ZTRTN="QUE^DENTCPM"
- SET ZTSAVE("U")=""
- SET ZTSAVE("D0")=""
- SET ZTSAVE("D1")=""
- DO ^%ZTLOAD
- KILL ZTSK,ZTRTN,ZTSAVE
- GOTO DENTPA
- QUE USE IO
- +1 WRITE @IOF,!,?26,"DENTAL APPOINTMENT SCHEDULE"
- +2 SET DFN=D0
- DO DEM^VADPT
- IF VAERR=0
- SET DENTNM=VADM(1)
- SET DENTSSN=$PIECE(VADM(2),"^")
- +3 IF $DATA(^DENT(220,D0,9,D1,0))
- SET L=^(0)
- SET Y=$PIECE(L,U,17)
- SET DENTRX=$PIECE(L,U,2)
- SET L=$PIECE(L,U,3,16)
- +4 FOR I=1:1:14
- SET L(I)=$PIECE(L,U,I)
- +5 WRITE !!,"PATIENT: "
- if $DATA(DENTNM)
- WRITE DENTNM
- WRITE ?39,"SSN: "
- if $DATA(DENTSSN)
- WRITE DENTSSN
- XECUTE ^DD("DD")
- WRITE ?55,"DATE ENTERED: ",Y,!
- FOR I=1:1:80
- WRITE "_"
- +6 WRITE !,"APPOINTMENTS",?30,1,?40,1,?50,2,?60,2,?70,3,?76,3
- +7 WRITE !,?11
- FOR I=1:1:33
- WRITE ?($X+1),$SELECT(I>9:$EXTRACT(I,2),1:I)
- +8 WRITE !
- FOR I=1:1:80
- WRITE "-"
- +9 WRITE !,"ITEM PROV",!
- +10 SET DENTX="PROPH^^PERIO^^ENDO^^REST^^SURG^^C&B^^PROS"
- +11 FOR I=5,7,9,1,3,11,13
- IF L(I)
- WRITE !,$PIECE(DENTX,U,I)
- if L(I+1)
- WRITE ?7,$PIECE(^DENT(220.5,L(I+1),0),U,2)
- SET I1=$SELECT(I=3:12+(2*L(1)),I=11:12+((L(1)+L(3))*2),I=13:12+((L(1)+L(3)+L(11))*2),1:12)
- SET DENTL=$SELECT(I=5!(I=7)!(I=9):"+ ",1:"* ")
- FOR A=1:1:L(I)
- WRITE ?I1,DENTL
- +12 SET DENTRX=$SELECT(DENTRX="Y":"will",DENTRX="N":"won't",1:"may")
- WRITE !!!,"The patient "_DENTRX_" be receiving MEDICATION prior to treatment.",!
- if $DATA(ZTSK)
- GOTO EXIT
- DENTPA WRITE !!,"Print another Appointment Schedule"
- SET %=2
- DO YN^DICN
- if %=0
- DO Q2
- if %=0
- GOTO DENTPA
- IF %=1
- GOTO PRINT
- EXIT XECUTE ^%ZIS("C")
- KILL %,A,DA,DENTDTE,DENTL,DENTNM,D0,DENTRX,DENTSSN,DENTX,DIC,DIE,DR,G,H,I,I1,L,X,Y,Z
- if $DATA(ZTSK)
- KILL ^%ZTSK(ZTSK),ZTSK
- QUIT
- INST WRITE !!!,"This module provides an optimized appointment schedule for individual",!,"patients, based on indicated procedures."
- +1 WRITE !,"General questions such as the patient's name and appointment date are asked",!,"first, then the number of appointments necessary for each procedure and"
- +2 WRITE !,"the provider's ID are asked. Additional help is available by entering",!,"a question mark during any entry.",!
- QUIT
- Q WRITE !!,"Enter a 'Y' for 'Yes' if you wish to see additional instructions on how to use",!,"this scheduling aid. Press return if you do not want additional instructions.",!,"Enter an uparrow (^) to exit this option entirely."
- QUIT
- Q1 WRITE !!,"Press return if you want to enter another appointment for a patient.",!,"Enter 'N' for 'No' if you do not want to enter another appointment",!,"and wish to exit this option."
- QUIT
- Q2 WRITE !!,"Enter a 'Y' for 'Yes' if you wish to print an appointment schedule",!,"for another patient or press return to exit this option."
- QUIT
