- 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 Feb 19, 2025@00:15:51 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 ;