SDCO4 ;ALB/RMO - Diagnosis - Check Out;08 DEC 1992 4:05 pm
;;5.3;Scheduling;**32,27,44,67,77,85,132,466**;08/13/93;Build 2
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCO4 1928 printed Oct 16, 2024@18:49:59 Page 2
SDCO4 ;ALB/RMO - Diagnosis - Check Out;08 DEC 1992 4:05 pm
+1 ;;5.3;Scheduling;**32,27,44,67,77,85,132,466**;08/13/93;Build 2
+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 ;
