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  Sep 23, 2025@20:25:51                                                                                                                                                                                                      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)