SDCO4.m

SDCO4 ;ALB/RMO - Diagnosis - Check Out;08 DEC 1992 4:05 pm

 ;;5.3;Scheduling;**32,27,44,67,77,85,132,466,1015**;08/13/93;Build 21

 ;

EN ;Entry point for SDCO DIAGNOSIS protocol

 ; Input  -- SDOE

 ;

 S VALMBCK=""

 ;

 ; -- if OLD encounter, quit

 IF '$$EDITOK^SDCO3($G(SDOE),1) G ENQ

 ;

 ; -- call PCE interview

 N SDVISIT,SDHL

 S SDVISIT=$P($G(^SCE(+SDOE,0)),U,5)

 S X=$$INTV^PXAPI("POV","SD","PIMS",SDVISIT)

 D BLD^SDCO S VALMBCK="R"

ENQ Q

 ;

DXASK(SDOE) ;Ask Diagnosis on Check Out

 ; Input  -- SDOE      Outpatient Encounter IEN

 ; Output --  0=No, 1=Yes/Required, 2=Yes/Not Required

 N SDCL,SDOE0,SDORG,Y

 S SDOE0=$G(^SCE(+SDOE,0)),SDCL=+$P(SDOE0,"^",4),SDORG=+$P(SDOE0,"^",8)

 I $$REQ^SDM1A(+SDOE0)'="CO" G DXASKQ

 I $$OCASN(SDOE) G DXASKQ

 I SDORG=1,'$$CLINIC^SDAMU(SDCL) G DXASKQ

 ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G DXASKQ  ;SD*5.3*466 allow diagnosis check for inpatients

 I +SDOE0<2961001 S Y=2 G DXASKQ

 I SDCL S Y=1 G DXASKQ

 I SDORG=3 S Y=1

DXASKQ Q +$G(Y)

 ;

OCASN(SDOE) ;determines if this is an occasion of service.

 ;  returns a 1 if and occasion 0 if not

 ;

 N ANS

 S ANS=$$CHKOCC^SCMSVDG1(SDOE)

 Q +$G(ANS)

 ;

SET(SDOE) ;Set-up Diagnosis Array for Outpatient Encounter

 ; Input  -- SDOE      Outpatient Encounter IEN

 ; Output -- SDDXY     Diagnosis Array Subscripted by a Number

 ;           SDCNT     Number of Array Entries

 N SDICD9,SDVPOV,SDDXS

 K SDDXY

 D GETDX^SDOE(SDOE,"SDDXS")

 S (SDCNT,SDVPOV)=0

 F  S SDVPOV=$O(SDDXS(SDVPOV)) Q:'SDVPOV  D

 . S SDICD9=+$G(SDDXS(SDVPOV))

 . S SDCNT=SDCNT+1

 . S SDDXY(SDCNT)=SDVPOV_"^"_SDICD9

SETQ Q

 ;

LIST(SDDXY) ;List Diagnosis Array

 ; Input  -- SDDXY     Diagnosis Array Subscripted by a Number

 ; Output -- List Diagnosis Array

 N I,SDDXD

 W !

 S I=0 F  S I=$O(SDDXY(I)) Q:'I  S SDDXD=$$DX^SDCO41(+$P(SDDXY(I),"^",2)) W !?2,I,"  ",$P(SDDXD,"^"),?15,$P(SDDXD,"^",2)

 Q

 ;

SDCO4     ;ALB/RMO - Diagnosis - Check Out;08 DEC 1992 4:05 pm

 +1       ;;5.3;Scheduling;**32,27,44,67,77,85,132,466,1015**;08/13/93;Build 21

 +2       ;

EN        ;Entry point for SDCO DIAGNOSIS protocol

 +1       ; Input  -- SDOE

 +2       ;

 +3        SET VALMBCK=""

 +4       ;

 +5       ; -- if OLD encounter, quit

 +6        IF '$$EDITOK^SDCO3($GET(SDOE),1)

               GOTO ENQ

 +7       ;

 +8       ; -- call PCE interview

 +9        NEW SDVISIT,SDHL

 +10       SET SDVISIT=$PIECE($GET(^SCE(+SDOE,0)),U,5)

 +11       SET X=$$INTV^PXAPI("POV","SD","PIMS",SDVISIT)

 +12       DO BLD^SDCO

           SET VALMBCK="R"

ENQ        QUIT 

 +1       ;

DXASK(SDOE) ;Ask Diagnosis on Check Out

 +1       ; Input  -- SDOE      Outpatient Encounter IEN

 +2       ; Output --  0=No, 1=Yes/Required, 2=Yes/Not Required

 +3        NEW SDCL,SDOE0,SDORG,Y

 +4        SET SDOE0=$GET(^SCE(+SDOE,0))

           SET SDCL=+$PIECE(SDOE0,"^",4)

           SET SDORG=+$PIECE(SDOE0,"^",8)

 +5        IF $$REQ^SDM1A(+SDOE0)'="CO"

               GOTO DXASKQ

 +6        IF $$OCASN(SDOE)

               GOTO DXASKQ

 +7        IF SDORG=1

               IF '$$CLINIC^SDAMU(SDCL)

                   GOTO DXASKQ

 +8       ;I "^1^2^"[("^"_SDORG_"^"),$$INP^SDAM2(+$P(SDOE0,"^",2),+SDOE0)="I" G DXASKQ  ;SD*5.3*466 allow diagnosis check for inpatients

 +9        IF +SDOE0<2961001

               SET Y=2

               GOTO DXASKQ

 +10       IF SDCL

               SET Y=1

               GOTO DXASKQ

 +11       IF SDORG=3

               SET Y=1

DXASKQ     QUIT +$GET(Y)

 +1       ;

OCASN(SDOE) ;determines if this is an occasion of service.

 +1       ;  returns a 1 if and occasion 0 if not

 +2       ;

 +3        NEW ANS

 +4        SET ANS=$$CHKOCC^SCMSVDG1(SDOE)

 +5        QUIT +$GET(ANS)

 +6       ;

SET(SDOE) ;Set-up Diagnosis Array for Outpatient Encounter

 +1       ; Input  -- SDOE      Outpatient Encounter IEN

 +2       ; Output -- SDDXY     Diagnosis Array Subscripted by a Number

 +3       ;           SDCNT     Number of Array Entries

 +4        NEW SDICD9,SDVPOV,SDDXS

 +5        KILL SDDXY

 +6        DO GETDX^SDOE(SDOE,"SDDXS")

 +7        SET (SDCNT,SDVPOV)=0

 +8        FOR 

               SET SDVPOV=$ORDER(SDDXS(SDVPOV))

               IF 'SDVPOV

                   QUIT 

               Begin DoDot:1

 +9                SET SDICD9=+$GET(SDDXS(SDVPOV))

 +10               SET SDCNT=SDCNT+1

 +11               SET SDDXY(SDCNT)=SDVPOV_"^"_SDICD9

               End DoDot:1

SETQ       QUIT 

 +1       ;

LIST(SDDXY) ;List Diagnosis Array

 +1       ; Input  -- SDDXY     Diagnosis Array Subscripted by a Number

 +2       ; Output -- List Diagnosis Array

 +3        NEW I,SDDXD

 +4        WRITE !

 +5        SET I=0

           FOR 

               SET I=$ORDER(SDDXY(I))

               IF 'I

                   QUIT 

               SET SDDXD=$$DX^SDCO41(+$PIECE(SDDXY(I),"^",2))

               WRITE !?2,I,"  ",$PIECE(SDDXD,"^"),?15,$PIECE(SDDXD,"^",2)

 +6        QUIT 

 +7       ;