- DENTE3 ;ISC2/HAG-COMINATION OF ROUTINES ;10/24/90 13:56 ;
- ;;1.2;DENTAL;**11,13,19,20**;Apr 15, 1996
- SRD ;RE-RELEASE A RANGE OF TREATMENT DATA
- S T1=1 R !!,"Select RELEASE DATE: ",Y:DTIME G EXIT:Y=""!(Y=U) I Y["?" S (A,Y)="" F T1=0:1 S (A,Y)=$O(^DENT(221,"AG",DENTSTA,A)) Q:Y="" X ^DD("DD") W !,?7,Y
- D CHK G EXIT:T1=0,SRD:Y="" S X=Y,%DT="E" D ^%DT G:Y<0 SRD S N=""
- F T1=0:1 S N=$O(^DENT(221,"AG",DENTSTA,Y,N)) Q:N="" D
- .K ^DENT(221,N,.1) S DENTPRV=$P(^DENT(221,N,0),"^",10)
- .S AG=$P(^DENT(221,N,0),"^",1) S:AG["." AG=$P(AG,".",1) S ^DENT(221,"A",DENTSTA,AG,N)="",^DENT(221,"AC",DENTSTA,AG,DENTPRV,N)="" Q
- D CHK G:T1=0 EXIT K ^DENT(221,"AG",DENTSTA,Y) X ^DD("DD") W !!,Y," station ",DENTSTA," has ",T1," treatment data entry now enabled for re-release." G SRD
- CHK W:T1=0 !!,?2,"There is no released data to enable for station ",DENTSTA,"." Q
- PROV ;CHECK PROVIDER STATUS
- W !! S DIC="^DENT(220.5,",DIC(0)="AELMQ",DLAYGO=220.5 D ^DIC K DLAYGO G:Y<0 EXIT S DA=+Y D LOCK^DENTE1 G:DENTL=0 PROV S DR="1;2",DIC("NO^")=1,DIE=DIC D ^DIE W ! L G PROV
- ATDEL ;DELETE SERVICE TAPE GLOBAL
- W *7,!!,"Before deleting this global, be sure that you have used the Generate Monthly",!,"Dental SERVICE Tape option to generate a tape to be mailed to the Austin, TX DPC."
- W !!,"Are you sure you want to delete the existing temporary global containing",!,"Dental SERVICE data" S %=2 D YN^DICN G ATDEL:%=0 I %'=1 W *7,!,"Nothing deleted." K % Q
- K ^UTILITY("DENTV"),% G EXIT
- DPSET ;SET STATEMENT - MUMPS X-REF FOR FIELD 2 IN FILE 221
- I X="GROUP" S $P(^DENT(221,DA,0),"^",2)="000000001",$P(^(0),"^",26)=4,^DENT(221,"D","000000001",DA)="" Q
- I '$D(DENTDFN),$P(^DENT(221,DA,0),"^",4)'="" S (DFN,DENTDFN)=$P(^DENT(221,DA,0),"^",4) D DEM^VADPT S DENTSSN=$P(VADM(2),"^")
- S:$G(DENTDFN)>0 $P(^DENT(221,DA,0),"^",4)=DENTDFN,^DENT(221,"E",DENTDFN,DA)="" S:$G(DENTSSN)'="" $P(^DENT(221,DA,0),"^",2)=DENTSSN,^DENT(221,"D",DENTSSN,DA)=""
- K DENTDFN,DENTSSN,DFN D KVAR^VADPT Q
- DPKILL ;KILL STATEMENT - MUMPS X-REF ON FIELD 2 IN FILE 221
- S Z=^DENT(221,DA,0),Z0=$P(Z,"^",4),Z1=$P(Z,"^",2),$P(Z,"^",2)="" S:X="GROUP" $P(Z,"^",26)="" S ^DENT(221,DA,0)=Z K:Z0'="" ^DENT(221,"E",Z0,DA) K:Z1 ^DENT(221,"D",Z1,DA) K Z,Z0,Z1 Q
- STA W !! S Z1=0 G W:'$D(^DENT(225,0)) F Z3=0:1:2 S Z1=$O(^(Z1)) Q:Z1'>0 S Z2=Z1
- G:Z3=0 W I Z3>1 S DIC="^DENT(225,",DIC(0)="AEMNQ",DIC("A")="Select STATION.DIVISION: " S:$D(DENTSTA) DIC("B")=$S(DENTSTA[" ":+DENTSTA,1:DENTSTA) D ^DIC Q:Y<0 K DIC("A"),DIC("B")
- S Z=$S(Z3=1:Z2,1:+Y),DENTSTA=$P(^DENT(225,Z,0),"^") G W:DENTSTA="" S Y=1 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" S Y=-1
- EXIT K A,AG,DENTL,DR,T1,N,X,Y Q
- PAT ; DENTAL PATIENT
- Q
- TOO ; TOOTH PATTERN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTE3 2781 printed Feb 18, 2025@23:12:59 Page 2
- DENTE3 ;ISC2/HAG-COMINATION OF ROUTINES ;10/24/90 13:56 ;
- +1 ;;1.2;DENTAL;**11,13,19,20**;Apr 15, 1996
- SRD ;RE-RELEASE A RANGE OF TREATMENT DATA
- +1 SET T1=1
- READ !!,"Select RELEASE DATE: ",Y:DTIME
- if Y=""!(Y=U)
- GOTO EXIT
- IF Y["?"
- SET (A,Y)=""
- FOR T1=0:1
- SET (A,Y)=$ORDER(^DENT(221,"AG",DENTSTA,A))
- if Y=""
- QUIT
- XECUTE ^DD("DD")
- WRITE !,?7,Y
- +2 DO CHK
- if T1=0
- GOTO EXIT
- if Y=""
- GOTO SRD
- SET X=Y
- SET %DT="E"
- DO ^%DT
- if Y<0
- GOTO SRD
- SET N=""
- +3 FOR T1=0:1
- SET N=$ORDER(^DENT(221,"AG",DENTSTA,Y,N))
- if N=""
- QUIT
- Begin DoDot:1
- +4 KILL ^DENT(221,N,.1)
- SET DENTPRV=$PIECE(^DENT(221,N,0),"^",10)
- +5 SET AG=$PIECE(^DENT(221,N,0),"^",1)
- if AG["."
- SET AG=$PIECE(AG,".",1)
- SET ^DENT(221,"A",DENTSTA,AG,N)=""
- SET ^DENT(221,"AC",DENTSTA,AG,DENTPRV,N)=""
- QUIT
- End DoDot:1
- +6 DO CHK
- if T1=0
- GOTO EXIT
- KILL ^DENT(221,"AG",DENTSTA,Y)
- XECUTE ^DD("DD")
- WRITE !!,Y," station ",DENTSTA," has ",T1," treatment data entry now enabled for re-release."
- GOTO SRD
- CHK if T1=0
- WRITE !!,?2,"There is no released data to enable for station ",DENTSTA,"."
- QUIT
- PROV ;CHECK PROVIDER STATUS
- +1 WRITE !!
- SET DIC="^DENT(220.5,"
- SET DIC(0)="AELMQ"
- SET DLAYGO=220.5
- DO ^DIC
- KILL DLAYGO
- if Y<0
- GOTO EXIT
- SET DA=+Y
- DO LOCK^DENTE1
- if DENTL=0
- GOTO PROV
- SET DR="1;2"
- SET DIC("NO^")=1
- SET DIE=DIC
- DO ^DIE
- WRITE !
- LOCK
- GOTO PROV
- ATDEL ;DELETE SERVICE TAPE GLOBAL
- +1 WRITE *7,!!,"Before deleting this global, be sure that you have used the Generate Monthly",!,"Dental SERVICE Tape option to generate a tape to be mailed to the Austin, TX DPC."
- +2 WRITE !!,"Are you sure you want to delete the existing temporary global containing",!,"Dental SERVICE data"
- SET %=2
- DO YN^DICN
- if %=0
- GOTO ATDEL
- IF %'=1
- WRITE *7,!,"Nothing deleted."
- KILL %
- QUIT
- +3 KILL ^UTILITY("DENTV"),%
- GOTO EXIT
- DPSET ;SET STATEMENT - MUMPS X-REF FOR FIELD 2 IN FILE 221
- +1 IF X="GROUP"
- SET $PIECE(^DENT(221,DA,0),"^",2)="000000001"
- SET $PIECE(^(0),"^",26)=4
- SET ^DENT(221,"D","000000001",DA)=""
- QUIT
- +2 IF '$DATA(DENTDFN)
- IF $PIECE(^DENT(221,DA,0),"^",4)'=""
- SET (DFN,DENTDFN)=$PIECE(^DENT(221,DA,0),"^",4)
- DO DEM^VADPT
- SET DENTSSN=$PIECE(VADM(2),"^")
- +3 if $GET(DENTDFN)>0
- SET $PIECE(^DENT(221,DA,0),"^",4)=DENTDFN
- SET ^DENT(221,"E",DENTDFN,DA)=""
- if $GET(DENTSSN)'=""
- SET $PIECE(^DENT(221,DA,0),"^",2)=DENTSSN
- SET ^DENT(221,"D",DENTSSN,DA)=""
- +4 KILL DENTDFN,DENTSSN,DFN
- DO KVAR^VADPT
- QUIT
- DPKILL ;KILL STATEMENT - MUMPS X-REF ON FIELD 2 IN FILE 221
- +1 SET Z=^DENT(221,DA,0)
- SET Z0=$PIECE(Z,"^",4)
- SET Z1=$PIECE(Z,"^",2)
- SET $PIECE(Z,"^",2)=""
- if X="GROUP"
- SET $PIECE(Z,"^",26)=""
- SET ^DENT(221,DA,0)=Z
- if Z0'=""
- KILL ^DENT(221,"E",Z0,DA)
- if Z1
- KILL ^DENT(221,"D",Z1,DA)
- KILL Z,Z0,Z1
- QUIT
- STA WRITE !!
- SET Z1=0
- if '$DATA(^DENT(225,0))
- GOTO W
- FOR Z3=0:1:2
- SET Z1=$ORDER(^(Z1))
- if Z1'>0
- QUIT
- SET Z2=Z1
- +1 if Z3=0
- GOTO W
- IF Z3>1
- SET DIC="^DENT(225,"
- SET DIC(0)="AEMNQ"
- SET DIC("A")="Select STATION.DIVISION: "
- if $DATA(DENTSTA)
- SET DIC("B")=$SELECT(DENTSTA[" ":+DENTSTA,1:DENTSTA)
- DO ^DIC
- if Y<0
- QUIT
- KILL DIC("A"),DIC("B")
- +2 SET Z=$SELECT(Z3=1:Z2,1:+Y)
- SET DENTSTA=$PIECE(^DENT(225,Z,0),"^")
- if DENTSTA=""
- GOTO W
- SET Y=1
- 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"
- SET Y=-1
- EXIT KILL A,AG,DENTL,DR,T1,N,X,Y
- QUIT
- PAT ; DENTAL PATIENT
- +1 QUIT
- TOO ; TOOTH PATTERN
- +1 QUIT