- SDCO41 ;ALB/RMO - Diagnosis Cont. - Check Out;19 MAR 1993 9:15 am
- ;;5.3;Scheduling;**15,351,586**;Aug 13, 1993;Build 28
- ;
- ; Reference to $$IMP^ICDEX supported by ICR #5747
- ; Reference to $$ICDDX^ICDEX supported by ICR #5747
- ; Reference to $$SYS^ICDEX supported by ICR #5747
- ; Reference to $$VLTD^ICDEX supported by ICR #5747
- ;
- DXHLP(SDCL) ;Diagnosis Help for Clinic
- ; Input -- SDCL Hospital Location file IEN
- ; Output -- Help
- N C,DIRUT,I,SDDXD,SDDXDF,SDICDI
- I '$O(^SC(SDCL,"DX",0)) G DXHLPQ
- W !!,"The following diagnoses are associated with ",$$LOWER^VALM1($P($G(^SC(SDCL,0)),"^")),":"
- W !!,"Default Diagnosis: " S SDDXDF=$$DXDEF(SDCL) W $S(SDDXDF:$P(SDDXDF,"^")_" "_$P(SDDXDF,"^",2),1:"[None]")
- W !!,"Other diagnoses: "
- S (C,I)=0 F S I=$O(^SC(SDCL,"DX",I)) Q:'I!($D(DIRUT)) I $D(^(I,0)) S SDICDI=+^(0) I '$D(^SC("ADDX",SDCL,I)) D
- .S C=C+1,SDDXD=$$DX(SDICDI)
- .W:C=1 !
- .D PAUSE^VALM1:'(C#20) Q:$D(DIRUT) W:(C#2) ! W:'(C#2) ?40
- .W $P(SDDXD,"^"),?($X+(8-$L($P(SDDXD,"^")))),$P(SDDXD,"^",2)
- W:'C "None"
- DXHLPQ Q
- ;
- DXDEF(SDCL) ;Diagnosis Default for Clinic
- ; Input -- SDCL Hospital Location file IEN
- ; Output -- Default
- N Y
- I $D(^SC("ADDX",SDCL)),$D(^SC(SDCL,"DX",+$O(^(SDCL,0)),0)) S Y=$$DX(+^(0))
- Q $G(Y)
- ;
- DX(SDICDI,SDDXDT) ;Diagnosis Display Data
- ; Input -- SDICDI IDC Diagnosis IEN
- ; -- SDDXDT Date to screen against
- ; Output -- Diagnosis Display Data - Code Number^Diagnosis
- N Y,SDXINF,IMPDT,DXTXT
- S SDDXDT=$G(SDDXDT,$G(ICDVDT)),IMPDT=$$IMP^ICDEX(30)
- S SDXINF=$$ICDDX^ICDEX(SDICDI,SDDXDT,+$$SYS^ICDEX("DIAG",SDDXDT,"I"),"I") ;SD*5.3*586
- S DXTXT=$S(SDDXDT<IMPDT:$P(SDXINF,"^",4),1:$$VLTD^ICDEX(SDICDI,SDDXDT))
- S Y=$S(+SDXINF>0:$P(SDXINF,"^",2)_"^"_DXTXT,1:"^Unknown")
- Q $G(Y)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO41 1779 printed Feb 19, 2025@00:15:52 Page 2
- SDCO41 ;ALB/RMO - Diagnosis Cont. - Check Out;19 MAR 1993 9:15 am
- +1 ;;5.3;Scheduling;**15,351,586**;Aug 13, 1993;Build 28
- +2 ;
- +3 ; Reference to $$IMP^ICDEX supported by ICR #5747
- +4 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
- +5 ; Reference to $$SYS^ICDEX supported by ICR #5747
- +6 ; Reference to $$VLTD^ICDEX supported by ICR #5747
- +7 ;
- DXHLP(SDCL) ;Diagnosis Help for Clinic
- +1 ; Input -- SDCL Hospital Location file IEN
- +2 ; Output -- Help
- +3 NEW C,DIRUT,I,SDDXD,SDDXDF,SDICDI
- +4 IF '$ORDER(^SC(SDCL,"DX",0))
- GOTO DXHLPQ
- +5 WRITE !!,"The following diagnoses are associated with ",$$LOWER^VALM1($PIECE($GET(^SC(SDCL,0)),"^")),":"
- +6 WRITE !!,"Default Diagnosis: "
- SET SDDXDF=$$DXDEF(SDCL)
- WRITE $SELECT(SDDXDF:$PIECE(SDDXDF,"^")_" "_$PIECE(SDDXDF,"^",2),1:"[None]")
- +7 WRITE !!,"Other diagnoses: "
- +8 SET (C,I)=0
- FOR
- SET I=$ORDER(^SC(SDCL,"DX",I))
- if 'I!($DATA(DIRUT))
- QUIT
- IF $DATA(^(I,0))
- SET SDICDI=+^(0)
- IF '$DATA(^SC("ADDX",SDCL,I))
- Begin DoDot:1
- +9 SET C=C+1
- SET SDDXD=$$DX(SDICDI)
- +10 if C=1
- WRITE !
- +11 if '(C#20)
- DO PAUSE^VALM1
- if $DATA(DIRUT)
- QUIT
- if (C#2)
- WRITE !
- if '(C#2)
- WRITE ?40
- +12 WRITE $PIECE(SDDXD,"^"),?($X+(8-$LENGTH($PIECE(SDDXD,"^")))),$PIECE(SDDXD,"^",2)
- End DoDot:1
- +13 if 'C
- WRITE "None"
- DXHLPQ QUIT
- +1 ;
- DXDEF(SDCL) ;Diagnosis Default for Clinic
- +1 ; Input -- SDCL Hospital Location file IEN
- +2 ; Output -- Default
- +3 NEW Y
- +4 IF $DATA(^SC("ADDX",SDCL))
- IF $DATA(^SC(SDCL,"DX",+$ORDER(^(SDCL,0)),0))
- SET Y=$$DX(+^(0))
- +5 QUIT $GET(Y)
- +6 ;
- DX(SDICDI,SDDXDT) ;Diagnosis Display Data
- +1 ; Input -- SDICDI IDC Diagnosis IEN
- +2 ; -- SDDXDT Date to screen against
- +3 ; Output -- Diagnosis Display Data - Code Number^Diagnosis
- +4 NEW Y,SDXINF,IMPDT,DXTXT
- +5 SET SDDXDT=$GET(SDDXDT,$GET(ICDVDT))
- SET IMPDT=$$IMP^ICDEX(30)
- +6 ;SD*5.3*586
- SET SDXINF=$$ICDDX^ICDEX(SDICDI,SDDXDT,+$$SYS^ICDEX("DIAG",SDDXDT,"I"),"I")
- +7 SET DXTXT=$SELECT(SDDXDT<IMPDT:$PIECE(SDXINF,"^",4),1:$$VLTD^ICDEX(SDICDI,SDDXDT))
- +8 SET Y=$SELECT(+SDXINF>0:$PIECE(SDXINF,"^",2)_"^"_DXTXT,1:"^Unknown")
- +9 QUIT $GET(Y)
