PXCED800 ;WASH/BDB - Used in editing the 800 node, Service Connected conditions ;1/18/05 3:33pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**124,168**;Aug 12, 1996;Build 14
;; ;
Q
;
; Classification type 1 - Agent Orange
; 2 - Ionizing Radiation
; 3 - Service Connected
; 4 - SW Asia Conditions
; 5 - Military Sexual Trauma
; 6 - Cancer of the Head and/or Neck
; 7 - Combat Veteran
; 8 - Project 112/SHAD
GET800 ;Used by the Service Connected Conditions
N PXCEINDX,PXOUT
N PXBDATA,PXLOC,PXAPTDT,PXDFN
S PXCEDXSC=""
I $O(^SCE("AVSIT",PXCEVIEN,0)) D CLASS^PXBAPI21("","","","",PXCEVIEN)
I '$O(^SCE("AVSIT",PXCEVIEN,0)) D
. S PXAPTDT=+^AUPNVSIT(PXCEVIEN,0)
. S PXDFN=$P(^AUPNVSIT(PXCEVIEN,0),"^",5)
. S PXLOC=$P(^AUPNVSIT(PXCEVIEN,0),"^",22)
. D CLASS^PXBAPI21("",PXDFN,PXAPTDT,PXLOC,"")
F PXCEINDX=1:1:8 I $G(PXBDATA("ERR",PXCEINDX))=4 S PXOUT=PXBDATA("ERR",PXCEINDX)
I $D(PXOUT) S PXCEEND=1 Q
S $P(PXCEDXSC,"^",1)=$P($G(PXBDATA(3)),"^",2)
I +PXCEDXSC S (PXDATA(1),PXDATA(2),PXDATA(4))="^^"
S $P(PXCEDXSC,"^",2)=$P($G(PXBDATA(1)),"^",2)
S $P(PXCEDXSC,"^",3)=$P($G(PXBDATA(2)),"^",2)
S $P(PXCEDXSC,"^",4)=$P($G(PXBDATA(4)),"^",2)
S $P(PXCEDXSC,"^",5)=$P($G(PXBDATA(5)),"^",2)
S $P(PXCEDXSC,"^",6)=$P($G(PXBDATA(6)),"^",2)
S $P(PXCEDXSC,"^",7)=$P($G(PXBDATA(7)),"^",2)
S $P(PXCEDXSC,"^",8)=$P($G(PXBDATA(8)),"^",2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCED800 1603 printed Nov 22, 2024@17:37:58 Page 2
PXCED800 ;WASH/BDB - Used in editing the 800 node, Service Connected conditions ;1/18/05 3:33pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,168**;Aug 12, 1996;Build 14
+2 ;; ;
+3 QUIT
+4 ;
+5 ; Classification type 1 - Agent Orange
+6 ; 2 - Ionizing Radiation
+7 ; 3 - Service Connected
+8 ; 4 - SW Asia Conditions
+9 ; 5 - Military Sexual Trauma
+10 ; 6 - Cancer of the Head and/or Neck
+11 ; 7 - Combat Veteran
+12 ; 8 - Project 112/SHAD
GET800 ;Used by the Service Connected Conditions
+1 NEW PXCEINDX,PXOUT
+2 NEW PXBDATA,PXLOC,PXAPTDT,PXDFN
+3 SET PXCEDXSC=""
+4 IF $ORDER(^SCE("AVSIT",PXCEVIEN,0))
DO CLASS^PXBAPI21("","","","",PXCEVIEN)
+5 IF '$ORDER(^SCE("AVSIT",PXCEVIEN,0))
Begin DoDot:1
+6 SET PXAPTDT=+^AUPNVSIT(PXCEVIEN,0)
+7 SET PXDFN=$PIECE(^AUPNVSIT(PXCEVIEN,0),"^",5)
+8 SET PXLOC=$PIECE(^AUPNVSIT(PXCEVIEN,0),"^",22)
+9 DO CLASS^PXBAPI21("",PXDFN,PXAPTDT,PXLOC,"")
End DoDot:1
+10 FOR PXCEINDX=1:1:8
IF $GET(PXBDATA("ERR",PXCEINDX))=4
SET PXOUT=PXBDATA("ERR",PXCEINDX)
+11 IF $DATA(PXOUT)
SET PXCEEND=1
QUIT
+12 SET $PIECE(PXCEDXSC,"^",1)=$PIECE($GET(PXBDATA(3)),"^",2)
+13 IF +PXCEDXSC
SET (PXDATA(1),PXDATA(2),PXDATA(4))="^^"
+14 SET $PIECE(PXCEDXSC,"^",2)=$PIECE($GET(PXBDATA(1)),"^",2)
+15 SET $PIECE(PXCEDXSC,"^",3)=$PIECE($GET(PXBDATA(2)),"^",2)
+16 SET $PIECE(PXCEDXSC,"^",4)=$PIECE($GET(PXBDATA(4)),"^",2)
+17 SET $PIECE(PXCEDXSC,"^",5)=$PIECE($GET(PXBDATA(5)),"^",2)
+18 SET $PIECE(PXCEDXSC,"^",6)=$PIECE($GET(PXBDATA(6)),"^",2)
+19 SET $PIECE(PXCEDXSC,"^",7)=$PIECE($GET(PXBDATA(7)),"^",2)
+20 SET $PIECE(PXCEDXSC,"^",8)=$PIECE($GET(PXBDATA(8)),"^",2)
+21 QUIT
+22 ;
