PXBAPI22 ;ISL/DCM - API for Classification check out ; 16 Oct 2006 9:42 PM
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,26,184,168,227**;Aug 12, 1996;Build 3
ONE(TYPI,DATA,ENCOWNTR,SQUIT) ;Process One Classification
; Input -- TYPI Outpatient Classification Type IEN
; DATA Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
; ENCOWNTR Outpatient Encounter file IEN (optional)
; Output -- SQUIT User entered '^' or timeout
N SDCT0,SDVAL
S SDCT0=$G(^SD(409.41,TYPI,0)) I SDCT0']"" S PXBDATA("ERR",TYPI)=1 Q ;Bad entry
I $P(DATA,"^",3) D:DATA S PXBDATA("ERR",TYPI)=2 Q ;Not applicable
.W !,$C(7),">>> "_$P(SDCT0,"^",6)_" is no longer applicable..."
.S DA=+DATA,DIK="^SDD(409.42," D ^DIK W "deleted."
I DATA,$P(DATA,"^",4) D S PXBDATA("ERR",TYPI)=3 Q ;Uneditable data
. W !,$P(SDCT0,"^",6)_": "_$$VAL^SDCODD(TYPI,$P(DATA,"^",2))_" <Uneditable>"
S SDVAL=$$VAL(TYPI,SDCT0,DATA) ;Get field value
I SDVAL="^" S SQUIT="",PXBDATA("ERR",TYPI)=4 Q ;user ^ out
D STORE(+DATA,SDVAL,TYPI)
Q
VAL(TYPI,SDCT0,DATA) ;Get Outpatient Classification
N DIR,DA,Y,SDXS,SDEF
I TYPI=1,$P($G(^DPT(DFN,.321)),"^",2)'="Y"!(($P($G(^DPT(DFN,.321)),"^",13)'="V")&($P($G(^DPT(DFN,.321)),"^",13)'="B")) G VALQ ;PX*1.0*227 - add BWN
I TYPI=2,$P($G(^DPT(DFN,.321)),"^",3)'="Y" G VALQ
I TYPI=4,$P($G(^DPT(DFN,.322)),"^",13)'="Y",'$$EC^SDCO22(DFN,ENCOWNTR) G VALQ
I TYPI=3,$P($G(^SCE(+$G(ENCOWNTR),0)),"^",10)=2 S Y=1 G VALQ ;Change SC to 'yes'
;Automation of the SC response
I TYPI=3,(+$G(PXD)!(+$G(PXDX))) D I Y'="",'$G(SDSCEDIT) G VALQ
.S SDXS($S(+$G(PXD):+PXD,1:+$G(PXDX)))=""
.S Y=$$SC^SDSCAPI(DFN,.SDXS,ENCOWNTR,$G(VISIT)) Q:Y=""
.S Y=+Y,SDEF=$S(Y:"YES",1:"NO")
.I '$G(SDSCEDIT) D
..W !,$S($P(SDCT0,"^",2)]"":$P(SDCT0,"^",2),1:$P(SDCT0,"^")),"? "
..W $S(Y:"YES",1:"NO")
REASK S DIR("A")=$S($P(SDCT0,"^",2)]"":$P(SDCT0,"^",2),1:$P(SDCT0,"^"))
I $P(DATA,"^",2)]""!($P(SDCT0,"^",4)]"") S DIR("B")=$S($D(SDEF):SDEF,$P(DATA,"^",2)]"":$$VAL^SDCODD(TYPI,$P(DATA,"^",2)),1:$P(SDCT0,"^",4))
S DIR(0)=$P(SDCT0,"^",3)_"O" S:$D(SDEF) DIR("B")=SDEF
I $D(^SD(409.41,TYPI,2)) S DIR(0)=DIR(0)_"^"_^(2)
I TYPI=3 S DIR("?")="^D SC^SDCO23(DFN)"
D ^DIR
I $P(SDCT0,"^",5),'$D(DTOUT),$P(DATA,"^",2)="",Y=""!(Y["^"&('$P($G(^DG(43,1,"SCLR")),"^",24))) D G REASK
.W !,$C(7),"This is a required response." W:Y["^" " An '^' is not allowed."
.K DIRUT,DUOUT
I $D(DIRUT) S Y="^"
VALQ K DIRUT,DTOUT,DUOUT
Q $G(Y)
;
STORE(SDCNI,SDCNV,TYPI) ;File Outpatient Classification
; Input -- SDCNI Outpatient Classification IEN
; SDCNV Outpatient Classification Value
; TYPI Classification type 1 - Agent Orange
; 2 - Ionizing Radiation
; 3 - Service Connected
; 4 - SW Asia Conditions
; Output -- PXBDATA array
; Error codes -- PXBDATA("ERR",TYPI)=1 - Bad ptr to 409.41 in TYPI
; 2 - DATA entry not applicable
; 3 - DATA entry uneditable
; 4 - User ^ out of prompt
S PXBDATA(TYPI)=SDCNI_"^"_SDCNV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBAPI22 3217 printed Oct 16, 2024@18:27:05 Page 2
PXBAPI22 ;ISL/DCM - API for Classification check out ; 16 Oct 2006 9:42 PM
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,26,184,168,227**;Aug 12, 1996;Build 3
ONE(TYPI,DATA,ENCOWNTR,SQUIT) ;Process One Classification
+1 ; Input -- TYPI Outpatient Classification Type IEN
+2 ; DATA Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
+3 ; ENCOWNTR Outpatient Encounter file IEN (optional)
+4 ; Output -- SQUIT User entered '^' or timeout
+5 NEW SDCT0,SDVAL
+6 ;Bad entry
SET SDCT0=$GET(^SD(409.41,TYPI,0))
IF SDCT0']""
SET PXBDATA("ERR",TYPI)=1
QUIT
+7 ;Not applicable
IF $PIECE(DATA,"^",3)
if DATA
Begin DoDot:1
+8 WRITE !,$CHAR(7),">>> "_$PIECE(SDCT0,"^",6)_" is no longer applicable..."
+9 SET DA=+DATA
SET DIK="^SDD(409.42,"
DO ^DIK
WRITE "deleted."
End DoDot:1
SET PXBDATA("ERR",TYPI)=2
QUIT
+10 ;Uneditable data
IF DATA
IF $PIECE(DATA,"^",4)
Begin DoDot:1
+11 WRITE !,$PIECE(SDCT0,"^",6)_": "_$$VAL^SDCODD(TYPI,$PIECE(DATA,"^",2))_" <Uneditable>"
End DoDot:1
SET PXBDATA("ERR",TYPI)=3
QUIT
+12 ;Get field value
SET SDVAL=$$VAL(TYPI,SDCT0,DATA)
+13 ;user ^ out
IF SDVAL="^"
SET SQUIT=""
SET PXBDATA("ERR",TYPI)=4
QUIT
+14 DO STORE(+DATA,SDVAL,TYPI)
+15 QUIT
VAL(TYPI,SDCT0,DATA) ;Get Outpatient Classification
+1 NEW DIR,DA,Y,SDXS,SDEF
+2 ;PX*1.0*227 - add BWN
IF TYPI=1
IF $PIECE($GET(^DPT(DFN,.321)),"^",2)'="Y"!(($PIECE($GET(^DPT(DFN,.321)),"^",13)'="V")&($PIECE($GET(^DPT(DFN,.321)),"^",13)'="B"))
GOTO VALQ
+3 IF TYPI=2
IF $PIECE($GET(^DPT(DFN,.321)),"^",3)'="Y"
GOTO VALQ
+4 IF TYPI=4
IF $PIECE($GET(^DPT(DFN,.322)),"^",13)'="Y"
IF '$$EC^SDCO22(DFN,ENCOWNTR)
GOTO VALQ
+5 ;Change SC to 'yes'
IF TYPI=3
IF $PIECE($GET(^SCE(+$GET(ENCOWNTR),0)),"^",10)=2
SET Y=1
GOTO VALQ
+6 ;Automation of the SC response
+7 IF TYPI=3
IF (+$GET(PXD)!(+$GET(PXDX)))
Begin DoDot:1
+8 SET SDXS($SELECT(+$GET(PXD):+PXD,1:+$GET(PXDX)))=""
+9 SET Y=$$SC^SDSCAPI(DFN,.SDXS,ENCOWNTR,$GET(VISIT))
if Y=""
QUIT
+10 SET Y=+Y
SET SDEF=$SELECT(Y:"YES",1:"NO")
+11 IF '$GET(SDSCEDIT)
Begin DoDot:2
+12 WRITE !,$SELECT($PIECE(SDCT0,"^",2)]"":$PIECE(SDCT0,"^",2),1:$PIECE(SDCT0,"^")),"? "
+13 WRITE $SELECT(Y:"YES",1:"NO")
End DoDot:2
End DoDot:1
IF Y'=""
IF '$GET(SDSCEDIT)
GOTO VALQ
REASK SET DIR("A")=$SELECT($PIECE(SDCT0,"^",2)]"":$PIECE(SDCT0,"^",2),1:$PIECE(SDCT0,"^"))
+1 IF $PIECE(DATA,"^",2)]""!($PIECE(SDCT0,"^",4)]"")
SET DIR("B")=$SELECT($DATA(SDEF):SDEF,$PIECE(DATA,"^",2)]"":$$VAL^SDCODD(TYPI,$PIECE(DATA,"^",2)),1:$PIECE(SDCT0,"^",4))
+2 SET DIR(0)=$PIECE(SDCT0,"^",3)_"O"
if $DATA(SDEF)
SET DIR("B")=SDEF
+3 IF $DATA(^SD(409.41,TYPI,2))
SET DIR(0)=DIR(0)_"^"_^(2)
+4 IF TYPI=3
SET DIR("?")="^D SC^SDCO23(DFN)"
+5 DO ^DIR
+6 IF $PIECE(SDCT0,"^",5)
IF '$DATA(DTOUT)
IF $PIECE(DATA,"^",2)=""
IF Y=""!(Y["^"&('$PIECE($GET(^DG(43,1,"SCLR")),"^",24)))
Begin DoDot:1
+7 WRITE !,$CHAR(7),"This is a required response."
if Y["^"
WRITE " An '^' is not allowed."
+8 KILL DIRUT,DUOUT
End DoDot:1
GOTO REASK
+9 IF $DATA(DIRUT)
SET Y="^"
VALQ KILL DIRUT,DTOUT,DUOUT
+1 QUIT $GET(Y)
+2 ;
STORE(SDCNI,SDCNV,TYPI) ;File Outpatient Classification
+1 ; Input -- SDCNI Outpatient Classification IEN
+2 ; SDCNV Outpatient Classification Value
+3 ; TYPI Classification type 1 - Agent Orange
+4 ; 2 - Ionizing Radiation
+5 ; 3 - Service Connected
+6 ; 4 - SW Asia Conditions
+7 ; Output -- PXBDATA array
+8 ; Error codes -- PXBDATA("ERR",TYPI)=1 - Bad ptr to 409.41 in TYPI
+9 ; 2 - DATA entry not applicable
+10 ; 3 - DATA entry uneditable
+11 ; 4 - User ^ out of prompt
+12 SET PXBDATA(TYPI)=SDCNI_"^"_SDCNV
+13 QUIT
