PXBAPI22 ;ISL/DCM - API for Classification check out ;8/30/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,26**;Aug 12, 1996
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
I TYPI=1,$P($G(^DPT(DFN,.321)),"^",2)'="Y" G VALQ
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'
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($P(DATA,"^",2)]"":$$VAL^SDCODD(TYPI,$P(DATA,"^",2)),1:$P(SDCT0,"^",4))
S DIR(0)=$P(SDCT0,"^",3)_"O"
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 - Environmental Contaminants
; 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
PXBAPI22 ;ISL/DCM - API for Classification check out ;8/30/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,26**;Aug 12, 1996
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
+2 IF TYPI=1
IF $PIECE($GET(^DPT(DFN,.321)),"^",2)'="Y"
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
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($PIECE(DATA,"^",2)]"":$$VAL^SDCODD(TYPI,$PIECE(DATA,"^",2)),1:$PIECE(SDCT0,"^",4))
+2 SET DIR(0)=$PIECE(SDCT0,"^",3)_"O"
+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 - Environmental Contaminants
+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
