- 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 Jan 18, 2025@03:27:23 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