PXCED800.m

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 ---PXCED800   1603     printed  Apr 09, 2024@21:28:09                                                                                                                                                                                                    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      ;