- 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 Feb 18, 2025@23:54:15 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 ;
