SDYQOECL ;ALB/MLI - Routine to put entries in file 409.41 ; 10/6/95 [10/6/95 2:28pm]
;;5.3;Scheduling;**35**,Aug 13, 1993
;
; This routine will set the following entries into the OUTPATIENT
; CLASSIFICATION TYPE file (#409.41) so that classification
; questions are no longer asked for stop codes:
;
; 149 - RADIATION THERAPY TREATMENT
; 150 - COMPUTERIZED TOMOGRAPHY (CT)
; 151 - MAGNETIC RESONANCE IMAGING/MRI
; 152 - ANGIOGRAM CATHETERIZATION
; 153 - INTERVENTIONAL RADIOGRAPHY
;
EN ; entry point to add stop codes to file 409.41
N DA,DIC,DLAYGO,SDYQERR,SDYQSTOP,X,Y
S SDYQERR=0
W !,">>>Adding entries to the OUTPATIENT CLASSIFICATION STOP CODE EXCEPTION",!?4,"file (#409.45)..."
F SDYQSTOP=149:1:153 D
. W !?4,"Stop code ",SDYQSTOP
. S DA=$O(^SD(409.45,"B",SDYQSTOP,0))
. I 'DA D Q:SDYQERR
. . K DD,DO
. . S X=SDYQSTOP,DIC="^SD(409.45,",DIC(0)="L",DLAYGO=409.45
. . D FILE^DICN S DA=+Y
. . I Y<0 S SDYQERR=1 W "...could not be added...try again later."
. . I Y>0 W "...added to file"
. I $O(^SD(409.45,DA,"E","B",2951001,0)) W "...already in file." Q
. S DIC="^SD(409.45,"_DA_",""E"",",DIC("P")=$P(^DD(409.45,75,0),"^",2)
. S DA(1)=DA,X="2951001",DIC(0)="L",DIC("DR")=".02///1" K DLAYGO
. K DD,DO
. D FILE^DICN
. W "...as of 10/1/95."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDYQOECL 1321 printed Nov 22, 2024@18:13:37 Page 2
SDYQOECL ;ALB/MLI - Routine to put entries in file 409.41 ; 10/6/95 [10/6/95 2:28pm]
+1 ;;5.3;Scheduling;**35**,Aug 13, 1993
+2 ;
+3 ; This routine will set the following entries into the OUTPATIENT
+4 ; CLASSIFICATION TYPE file (#409.41) so that classification
+5 ; questions are no longer asked for stop codes:
+6 ;
+7 ; 149 - RADIATION THERAPY TREATMENT
+8 ; 150 - COMPUTERIZED TOMOGRAPHY (CT)
+9 ; 151 - MAGNETIC RESONANCE IMAGING/MRI
+10 ; 152 - ANGIOGRAM CATHETERIZATION
+11 ; 153 - INTERVENTIONAL RADIOGRAPHY
+12 ;
EN ; entry point to add stop codes to file 409.41
+1 NEW DA,DIC,DLAYGO,SDYQERR,SDYQSTOP,X,Y
+2 SET SDYQERR=0
+3 WRITE !,">>>Adding entries to the OUTPATIENT CLASSIFICATION STOP CODE EXCEPTION",!?4,"file (#409.45)..."
+4 FOR SDYQSTOP=149:1:153
Begin DoDot:1
+5 WRITE !?4,"Stop code ",SDYQSTOP
+6 SET DA=$ORDER(^SD(409.45,"B",SDYQSTOP,0))
+7 IF 'DA
Begin DoDot:2
+8 KILL DD,DO
+9 SET X=SDYQSTOP
SET DIC="^SD(409.45,"
SET DIC(0)="L"
SET DLAYGO=409.45
+10 DO FILE^DICN
SET DA=+Y
+11 IF Y<0
SET SDYQERR=1
WRITE "...could not be added...try again later."
+12 IF Y>0
WRITE "...added to file"
End DoDot:2
if SDYQERR
QUIT
+13 IF $ORDER(^SD(409.45,DA,"E","B",2951001,0))
WRITE "...already in file."
QUIT
+14 SET DIC="^SD(409.45,"_DA_",""E"","
SET DIC("P")=$PIECE(^DD(409.45,75,0),"^",2)
+15 SET DA(1)=DA
SET X="2951001"
SET DIC(0)="L"
SET DIC("DR")=".02///1"
KILL DLAYGO
+16 KILL DD,DO
+17 DO FILE^DICN
+18 WRITE "...as of 10/1/95."
End DoDot:1
+19 QUIT
