SD5363PT ;ALB/MLI - Routine to put entries in file 409.45 ; 10/6/95
;;5.3;Scheduling;**63**,Aug 13, 1993
;
; This routine will set the following entries into the OUTPATIENT
; CLASSIFICATION TYPE file (#409.45) so that classification
; questions are no longer asked for stop codes:
;
; 421 VASCULAR LABORATORY
; 703 MAMMOGRAM
;
; It will add the following inactivate dates for the following
; codes so classification questions will be asked.
;
; 117 NURSING
; 118 HOME TREATMENT SERVICES
; 119 COMM NURSING HOME FOLLOW-UP
; 120 HEALTH SCREENING
; 121 RESID CARE PROGRAM FOLLOW-UP
; 122 PUBLIC HEALTH NURSING
; 123 NUTRITION/DIETETICS-INDIVIDUAL
; 124 NUTRITION/DIETETICS-GROUP
; 125 SOCIAL WORK SERVICE
;
EN ; entry point to add stop codes to file 409.45
N DA,DIC,DLAYGO,MSG,SDYQERR,SDYQSTOP,STOPIEN,X,Y
S SDYQERR=0
D BMES^XPDUTL(">>>Adding entries to the OUTPATIENT CLASSIFICATION STOP CODE EXCEPTION")
D MES^XPDUTL("file (#409.45)..."),MES^XPDUTL("")
F SDYQSTOP=421,703 D
. S MSG=" 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 D MES^XPDUTL(MSG_"...could not be added...try again later.")
. . I Y>0 D MES^XPDUTL(MSG_"...added to file as of 9/1/96")
. I $O(^SD(409.45,DA,"E","B",2960901,0)) D MES^XPDUTL(MSG_"...already in file.") Q
. D STORE(DA,1)
;
D BMES^XPDUTL(">>>Inactivating the following entries:")
F SDYQSTOP=117:1:125 D
. S MSG=" Stop code "_SDYQSTOP
. S DA=$O(^SD(409.45,"B",SDYQSTOP,0))
. I 'DA D MES^XPDUTL(MSG_" could not be found in exemption file...nothing updated") Q
. S STOPIEN=$O(^DIC(40.7,"C",SDYQSTOP,0))
. I STOPIEN,$$EX^SDCOU2(STOPIEN) D Q
. . D STORE(DA,0)
. . D MES^XPDUTL(MSG_" no longer exempt from classification questions")
. D MES^XPDUTL(MSG_" already exempt")
Q
;
;
STORE(DA,ONOFF) ; create entry for act/inact
; Input: DA as IEN of 409.45
; ONOFF as 1 for act; 0 for inact
;
N DIC,DLAYGO,X,Y
S DIC="^SD(409.45,"_DA_",""E"",",DIC("P")=$P(^DD(409.45,75,0),"^",2)
S DA(1)=DA,DIC(0)="L"
S X="2961001",DIC("DR")=".02///^S X=ONOFF"
K DD,DO
D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5363PT 2340 printed Apr 09, 2024@21:58:29 Page 2
SD5363PT ;ALB/MLI - Routine to put entries in file 409.45 ; 10/6/95
+1 ;;5.3;Scheduling;**63**,Aug 13, 1993
+2 ;
+3 ; This routine will set the following entries into the OUTPATIENT
+4 ; CLASSIFICATION TYPE file (#409.45) so that classification
+5 ; questions are no longer asked for stop codes:
+6 ;
+7 ; 421 VASCULAR LABORATORY
+8 ; 703 MAMMOGRAM
+9 ;
+10 ; It will add the following inactivate dates for the following
+11 ; codes so classification questions will be asked.
+12 ;
+13 ; 117 NURSING
+14 ; 118 HOME TREATMENT SERVICES
+15 ; 119 COMM NURSING HOME FOLLOW-UP
+16 ; 120 HEALTH SCREENING
+17 ; 121 RESID CARE PROGRAM FOLLOW-UP
+18 ; 122 PUBLIC HEALTH NURSING
+19 ; 123 NUTRITION/DIETETICS-INDIVIDUAL
+20 ; 124 NUTRITION/DIETETICS-GROUP
+21 ; 125 SOCIAL WORK SERVICE
+22 ;
EN ; entry point to add stop codes to file 409.45
+1 NEW DA,DIC,DLAYGO,MSG,SDYQERR,SDYQSTOP,STOPIEN,X,Y
+2 SET SDYQERR=0
+3 DO BMES^XPDUTL(">>>Adding entries to the OUTPATIENT CLASSIFICATION STOP CODE EXCEPTION")
+4 DO MES^XPDUTL("file (#409.45)...")
DO MES^XPDUTL("")
+5 FOR SDYQSTOP=421,703
Begin DoDot:1
+6 SET MSG=" Stop code "_SDYQSTOP
+7 SET DA=$ORDER(^SD(409.45,"B",SDYQSTOP,0))
+8 IF 'DA
Begin DoDot:2
+9 KILL DD,DO
+10 SET X=SDYQSTOP
SET DIC="^SD(409.45,"
SET DIC(0)="L"
SET DLAYGO=409.45
+11 DO FILE^DICN
SET DA=+Y
+12 IF Y<0
SET SDYQERR=1
DO MES^XPDUTL(MSG_"...could not be added...try again later.")
+13 IF Y>0
DO MES^XPDUTL(MSG_"...added to file as of 9/1/96")
End DoDot:2
if SDYQERR
QUIT
+14 IF $ORDER(^SD(409.45,DA,"E","B",2960901,0))
DO MES^XPDUTL(MSG_"...already in file.")
QUIT
+15 DO STORE(DA,1)
End DoDot:1
+16 ;
+17 DO BMES^XPDUTL(">>>Inactivating the following entries:")
+18 FOR SDYQSTOP=117:1:125
Begin DoDot:1
+19 SET MSG=" Stop code "_SDYQSTOP
+20 SET DA=$ORDER(^SD(409.45,"B",SDYQSTOP,0))
+21 IF 'DA
DO MES^XPDUTL(MSG_" could not be found in exemption file...nothing updated")
QUIT
+22 SET STOPIEN=$ORDER(^DIC(40.7,"C",SDYQSTOP,0))
+23 IF STOPIEN
IF $$EX^SDCOU2(STOPIEN)
Begin DoDot:2
+24 DO STORE(DA,0)
+25 DO MES^XPDUTL(MSG_" no longer exempt from classification questions")
End DoDot:2
QUIT
+26 DO MES^XPDUTL(MSG_" already exempt")
End DoDot:1
+27 QUIT
+28 ;
+29 ;
STORE(DA,ONOFF) ; create entry for act/inact
+1 ; Input: DA as IEN of 409.45
+2 ; ONOFF as 1 for act; 0 for inact
+3 ;
+4 NEW DIC,DLAYGO,X,Y
+5 SET DIC="^SD(409.45,"_DA_",""E"","
SET DIC("P")=$PIECE(^DD(409.45,75,0),"^",2)
+6 SET DA(1)=DA
SET DIC(0)="L"
+7 SET X="2961001"
SET DIC("DR")=".02///^S X=ONOFF"
+8 KILL DD,DO
+9 DO FILE^DICN
+10 QUIT
