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 Dec 13, 2024@01:46:37 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
