OOPSXP8 ;WIOFO/LLH-INIT ROUTINE FOR PATCH 8 ;5/1/2000
;;1.0;ASISTS;**8**;Jun 01, 1998
;
VAL(IEN) ; Determine pay rate, convert if called from ????
; input - IEN of case
; output - VAL returns 1 is field is convertable
; - PAY is set to the conversion value to be set into fld 167
; in the subroutine PAY below
;
; Code to test for a value of 1,2,6 is included as defensive code
; in the event that the package file check fails and this code is
; run more than once. It 'protects' valid codes. These values should
; not be present prior to the conversion.
;
N STR,VAL
S STR=$G(^OOPS(2260,IEN,"CA1L")),PAY=$P($G(STR),U,2)
S PAY=$$UP^OOPSUTL4(PAY),PAY=$TR(PAY,"- ","")
I PAY="Y"!(PAY="YR")!($E(PAY,1,4)="YEAR")!(PAY="A")!(PAY="AN")!($E(PAY,1,4)="ANNU") S PAY="ANNUAL"
I PAY="H"!(PAY="HR")!($E(PAY,1,4)="HOUR") S PAY="HOURLY"
I PAY="W"!(PAY=1)!(PAY="WK")!($E(PAY,1,4)="WEEK") S PAY="WEEKLY"
I PAY="B"!(PAY=2)!(PAY="BI")!($E(PAY,1,4)="BIWE") S PAY="BI-WEEKLY"
I PAY="D"!(PAY=6)!(PAY="DA")!(PAY="DAILY")!(PAY="PERDIEM") S PAY="DAILY"
S VAL=$S(PAY="ANNUAL":1,PAY="HOURLY":1,PAY="WEEKLY":1,PAY="BI-WEEKLY":1,PAY="DAILY":1,PAY="":1,1:0)
Q VAL
POST ;
N MSG,PAY,PMSG
S MSG(1)=" "
S MSG(2)="The PAY RATE PER Field (#167) in the ASISTS ACCIDENT REPORTING "
S MSG(3)="File (#2260) has been changed from a free text field to a "
S MSG(4)="set of codes field."
S MSG(5)="This routine will convert the current data in the PAY RATE PER "
S MSG(6)="field for cases that a valid code can be determined."
S MSG(7)="The Set of Codes are: "
S MSG(8)="1 - Weekly H - Hourly"
S MSG(9)="2 - Bi-weekly A - Annual"
S MSG(10)="6 - Daily"
S MSG(11)="Any case that the correct code cannot be determined for will"
S MSG(12)="be included in the install file and the PAY RATE PER data deleted."
S MSG(13)="An option is provided with the patch that will allow"
S MSG(14)="a user to correct the data after installation of the patch."
S MSG(15)="If required (cases are present with data that could not be "
S MSG(16)="converted), install the option as a secondary menu on the"
S MSG(17)="appropriate users' menu and instruct them to make the data"
S MSG(18)="corrections."
;
I $$PATCH^XPDUTL("OOPS*1.0*8") D Q
. D BMES^XPDUTL(" Skipping post install since patch was previously installed.")
D BMES^XPDUTL("Data Conversion in Progress...") H 1
D MES^XPDUTL(" ")
D PAY
I PMSG D MES^XPDUTL(.MSG) H 3
D DICT
K DIC,DLAYGO
Q
;
PAY ; Convert the PAY RATE PER field to the set of codes. Also convert
; the WITNESS NAME (#115) and move to WITNESS NAME (#2260.0125,.01)
N IEN,INJ,DR,DA,DIE,WITNM
S IEN=0,DIE="^OOPS(2260,",PMSG=0
F S IEN=$O(^OOPS(2260,IEN)) Q:IEN'>0 D
. S WITNM=$P($G(^OOPS(2260,IEN,"CA1D")),U)
. I $G(WITNM)'="" D
.. ; set the witness name into new field, kill #115)
.. S ^OOPS(2260,IEN,"CA1W",0)="^2260.0125A^1^1"
.. S $P(^OOPS(2260,IEN,"CA1W",1,0),U)=WITNM
.. S ^OOPS(2260,IEN,"CA1W","B",WITNM,1)=""
.. S $P(^OOPS(2260,IEN,"CA1D"),U)=""
. S INJ=$P($G(^OOPS(2260,IEN,0)),U,7)
. I INJ=1 D
.. I '$$VAL(IEN) D Q
... D MES^XPDUTL("Pay Rate Per cannot be converted for Case "_$$GET1^DIQ(2260,IEN,.01,"E")_" - "_$$GET1^DIQ(2260,IEN,167,"I"))
... S $P(^OOPS(2260,IEN,"CA1L"),U,2)="",PMSG=1
.. S DA=IEN,DR="167///^S X=PAY"
.. D:PAY]"" ^DIE
D BMES^XPDUTL("Pay Rate Per Conversion complete.")
Q
DICT NEW DIE,DA,DIC,X,DR,I
K DES,CODE,MODCODE,NEWCODE
MODC F I=1:1 S MODCODE=$P($T(MODCODE+I),";;",2) Q:MODCODE="" D
. K DO,DD,DR
. S (DIC,DIE)="^OOPS(2261.1,",DR=""
. S DA=$P(MODCODE,";",3)
. Q:'DA
. S DES=$P(MODCODE,";",2),CODE=$P(MODCODE,";")
. Q:($$GET1^DIQ(2261.1,DA,.01,"E")=DES)
. S DR(1,2261.1,1)=".01////^S X=DES"
. S DR(1,2261.1,2)="1////^S X=CODE"
. D ^DIE
K DES,CODE,MODCODE
NEWC F I=1:1 S NEWCODE=$P($T(NEWCODE+I),";;",2) Q:NEWCODE="" D
. S DIC="^OOPS(2261.1,",DIC(0)="LQZ",DLAYGO=2261.1
. S X=$P(NEWCODE,";",2),CODE=$P(NEWCODE,";")
. Q:$D(^OOPS(2261.1,"C",CODE)) ; don't set if code exists
. S DIC("DR")="1////^S X=CODE"
. K DO,DD D FILE^DICN K DLAYGO
K CODE,DES,NEWCODE
D BMES^XPDUTL("Table updates completed.")
Q
;
MODCODE(LINE) ; MODIFY BODY PART DESCRIPTION AND CODE
;;BA;ABDOMEN;1
;;BC;CHEST;7
;;HF;FACE;11
;;CM;MOUTH;18
;;HK;NECK;19
;;CN;NOSE, INTERNAL;20
;;BZ;EXTERNAL, EXTERNAL, OTHER;21
;;RP;PELVIS;22
;;RB;RIB;23
;;CC;SKULL (CRANIAL BONES);25
;;BL;LOWER BACK/BUTTOCKS;29
;;
NEWCODE(LINE) ; ADD NEW BODY PART CODE AND DESCRIPTION
;;AB;BOTH ARMS AND/OR WRIST
;;AS;SINGLE ARM AND/OR WRIST
;;B1;SINGLE BREAST
;;B2;BOTH BREASTS
;;B3;SINGLE TESTICLE
;;B4;BOTH TESTICLES
;;BP;PENIS
;;BS;SIDE/FLANK
;;BU;UPPER BACK
;;BW;WAIST
;;C1;SINGLE EAR
;;C2;BOTH EARS
;;C3;SINGLE EYE
;;C4;BOTH EYES
;;CB;BRAIN
;;CD;TEETH
;;CJ;JAW, MANDIBLE
;;CL;LARYNX
;;CR;THROAT, OTHER
;;CT;TONGUE
;;CZ;HEAD, INTERNAL, OTHER
;;EB;BOTH ELBOWS
;;ES;SINGLE ELBOW
;;F1;SINGLE FIRST FINGER
;;F2;BOTH FIRST FINGERS
;;F3;SINGLE SECOND FINGER
;;F4;BOTH SECOND FINGERS
;;F5;SINGLE THIRD FINGER
;;F6;BOTH THIRD FINGERS
;;F7;SINGLE FOURTH FINGER
;;F8;BOTH FOURTH FINGERS
;;G1;SINGLE GREAT TOE
;;G2;BOTH GREAT TOES
;;G3;OTH/MULT TOE(S), SINGLE FOOT
;;G4;OTH/MUTL TOE(S), BOTH FEET
;;H1;SINGLE EYE (EXTERNAL)
;;H2;BOTH EYES (EXTERNAL)
;;H3;SINGLE EAR (EXTERNAL)
;;H4;BOTH EARS (EXTERNAL)
;;HC;CHIN
;;HM;LIPS
;;HN;NOSE
;;HS;SCALP
;;KB;BOTH KNEES
;;KS;SINGLE KNEE
;;LB;BOTH LEGS/HIPS/ANKLES/BUTTOCKS
;;LS;SINGLE LEG/HIP/ANKLE/BUTTOCK
;;MB;BOTH HANDS
;;MS;SINGLE HAND
;;PB;BOTH FEET
;;PS;SINGLE FOOT
;;R1;SINGLE CLAVICLE
;;R2;BOTH CLAVICLES
;;R3;SINGLE SCAPULA
;;R4;BOTH SCAPULAE
;;RS;STERNUM
;;RV;VERTEBRA (SPINE, SPINAL COL)
;;RZ;TRUNK BONE, OTHER
;;SB;BOTH SHOULDERS
;;SS;SINGLE SHOULDER
;;TB;BOTH THUMBS
;;TS;SINGLE THUMB
;;V1;SINGLE LUNG
;;V2;BOTH LUNGS
;;V3;SINGLE KIDNEY
;;V4;BOTH KIDNEYS
;;VH;HEART
;;VL;LIVER
;;VR;REPRODUCTIVE ORGANS
;;VS;STOMACH
;;VI;Intestines
;;VZ;TRUNK, INTERNAL, OTHER
;;L4;BOTH LOWER LEG/ANKLES
;;A1;SINGLE UPPER ARM
;;A2;BOTH UPPER ARMS
;;A3;SINGLE FOREARM
;;A4;BOTH FOREARMS
;;A5;SINGLE WRIST
;;A6;BOTH WRISTS
;;AZ;ARM(S), OTHER
;;AX;ARM(S), MULTIPLE SITES
;;FS;MULTIPLE FINGERS, SINGLE HAND
;;FB;MULTIPLE FINGERS, BOTH HANDS
;;L1;SINGLE HIP/THIGH
;;L2;BOTH HIPS/THIGHS
;;L3;SINGLE LOWER LEG/ANKLE
;;LZ;LEG(S), OTHER
;;LX;LEG(S), MULTIPLE SITES
;;HZ;HEAD, EXTERNAL, OTHER
;;HX;HEAD, EXTERNAL, MULTIPLE SITES
;;CK;BONES OF FACE, OTHER(S)
;;CS;SINUS (ES)
;;CX;HEAD, INTERNAL, MULTIPLE SITES
;;B5;VULVA/VAGINA
;;BX;TRUNK, EXTERNAL, MULT SITES
;;RC;RIBS, MULTIPLE
;;RX;TRUNK, MULTIPLE BONES
;;V5;BLADDER, URETHRA
;;VC;SPINAL CORD
;;VN;NERVE
;;VM;SPLEEN
;;VX;TRUNK, INTERNAL, MULT ORGANS
;;XX;MULTIPLE ANATOMICAL SITES
;;XZ;ANATOMIC SITE NOT MENTIONED
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSXP8 7033 printed Dec 13, 2024@01:39:58 Page 2
OOPSXP8 ;WIOFO/LLH-INIT ROUTINE FOR PATCH 8 ;5/1/2000
+1 ;;1.0;ASISTS;**8**;Jun 01, 1998
+2 ;
VAL(IEN) ; Determine pay rate, convert if called from ????
+1 ; input - IEN of case
+2 ; output - VAL returns 1 is field is convertable
+3 ; - PAY is set to the conversion value to be set into fld 167
+4 ; in the subroutine PAY below
+5 ;
+6 ; Code to test for a value of 1,2,6 is included as defensive code
+7 ; in the event that the package file check fails and this code is
+8 ; run more than once. It 'protects' valid codes. These values should
+9 ; not be present prior to the conversion.
+10 ;
+11 NEW STR,VAL
+12 SET STR=$GET(^OOPS(2260,IEN,"CA1L"))
SET PAY=$PIECE($GET(STR),U,2)
+13 SET PAY=$$UP^OOPSUTL4(PAY)
SET PAY=$TRANSLATE(PAY,"- ","")
+14 IF PAY="Y"!(PAY="YR")!($EXTRACT(PAY,1,4)="YEAR")!(PAY="A")!(PAY="AN")!($EXTRACT(PAY,1,4)="ANNU")
SET PAY="ANNUAL"
+15 IF PAY="H"!(PAY="HR")!($EXTRACT(PAY,1,4)="HOUR")
SET PAY="HOURLY"
+16 IF PAY="W"!(PAY=1)!(PAY="WK")!($EXTRACT(PAY,1,4)="WEEK")
SET PAY="WEEKLY"
+17 IF PAY="B"!(PAY=2)!(PAY="BI")!($EXTRACT(PAY,1,4)="BIWE")
SET PAY="BI-WEEKLY"
+18 IF PAY="D"!(PAY=6)!(PAY="DA")!(PAY="DAILY")!(PAY="PERDIEM")
SET PAY="DAILY"
+19 SET VAL=$SELECT(PAY="ANNUAL":1,PAY="HOURLY":1,PAY="WEEKLY":1,PAY="BI-WEEKLY":1,PAY="DAILY":1,PAY="":1,1:0)
+20 QUIT VAL
POST ;
+1 NEW MSG,PAY,PMSG
+2 SET MSG(1)=" "
+3 SET MSG(2)="The PAY RATE PER Field (#167) in the ASISTS ACCIDENT REPORTING "
+4 SET MSG(3)="File (#2260) has been changed from a free text field to a "
+5 SET MSG(4)="set of codes field."
+6 SET MSG(5)="This routine will convert the current data in the PAY RATE PER "
+7 SET MSG(6)="field for cases that a valid code can be determined."
+8 SET MSG(7)="The Set of Codes are: "
+9 SET MSG(8)="1 - Weekly H - Hourly"
+10 SET MSG(9)="2 - Bi-weekly A - Annual"
+11 SET MSG(10)="6 - Daily"
+12 SET MSG(11)="Any case that the correct code cannot be determined for will"
+13 SET MSG(12)="be included in the install file and the PAY RATE PER data deleted."
+14 SET MSG(13)="An option is provided with the patch that will allow"
+15 SET MSG(14)="a user to correct the data after installation of the patch."
+16 SET MSG(15)="If required (cases are present with data that could not be "
+17 SET MSG(16)="converted), install the option as a secondary menu on the"
+18 SET MSG(17)="appropriate users' menu and instruct them to make the data"
+19 SET MSG(18)="corrections."
+20 ;
+21 IF $$PATCH^XPDUTL("OOPS*1.0*8")
Begin DoDot:1
+22 DO BMES^XPDUTL(" Skipping post install since patch was previously installed.")
End DoDot:1
QUIT
+23 DO BMES^XPDUTL("Data Conversion in Progress...")
HANG 1
+24 DO MES^XPDUTL(" ")
+25 DO PAY
+26 IF PMSG
DO MES^XPDUTL(.MSG)
HANG 3
+27 DO DICT
+28 KILL DIC,DLAYGO
+29 QUIT
+30 ;
PAY ; Convert the PAY RATE PER field to the set of codes. Also convert
+1 ; the WITNESS NAME (#115) and move to WITNESS NAME (#2260.0125,.01)
+2 NEW IEN,INJ,DR,DA,DIE,WITNM
+3 SET IEN=0
SET DIE="^OOPS(2260,"
SET PMSG=0
+4 FOR
SET IEN=$ORDER(^OOPS(2260,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+5 SET WITNM=$PIECE($GET(^OOPS(2260,IEN,"CA1D")),U)
+6 IF $GET(WITNM)'=""
Begin DoDot:2
+7 ; set the witness name into new field, kill #115)
+8 SET ^OOPS(2260,IEN,"CA1W",0)="^2260.0125A^1^1"
+9 SET $PIECE(^OOPS(2260,IEN,"CA1W",1,0),U)=WITNM
+10 SET ^OOPS(2260,IEN,"CA1W","B",WITNM,1)=""
+11 SET $PIECE(^OOPS(2260,IEN,"CA1D"),U)=""
End DoDot:2
+12 SET INJ=$PIECE($GET(^OOPS(2260,IEN,0)),U,7)
+13 IF INJ=1
Begin DoDot:2
+14 IF '$$VAL(IEN)
Begin DoDot:3
+15 DO MES^XPDUTL("Pay Rate Per cannot be converted for Case "_$$GET1^DIQ(2260,IEN,.01,"E")_" - "_$$GET1^DIQ(2260,IEN,167,"I"))
+16 SET $PIECE(^OOPS(2260,IEN,"CA1L"),U,2)=""
SET PMSG=1
End DoDot:3
QUIT
+17 SET DA=IEN
SET DR="167///^S X=PAY"
+18 if PAY]""
DO ^DIE
End DoDot:2
End DoDot:1
+19 DO BMES^XPDUTL("Pay Rate Per Conversion complete.")
+20 QUIT
DICT NEW DIE,DA,DIC,X,DR,I
+1 KILL DES,CODE,MODCODE,NEWCODE
MODC FOR I=1:1
SET MODCODE=$PIECE($TEXT(MODCODE+I),";;",2)
if MODCODE=""
QUIT
Begin DoDot:1
+1 KILL DO,DD,DR
+2 SET (DIC,DIE)="^OOPS(2261.1,"
SET DR=""
+3 SET DA=$PIECE(MODCODE,";",3)
+4 if 'DA
QUIT
+5 SET DES=$PIECE(MODCODE,";",2)
SET CODE=$PIECE(MODCODE,";")
+6 if ($$GET1^DIQ(2261.1,DA,.01,"E")=DES)
QUIT
+7 SET DR(1,2261.1,1)=".01////^S X=DES"
+8 SET DR(1,2261.1,2)="1////^S X=CODE"
+9 DO ^DIE
End DoDot:1
+10 KILL DES,CODE,MODCODE
NEWC FOR I=1:1
SET NEWCODE=$PIECE($TEXT(NEWCODE+I),";;",2)
if NEWCODE=""
QUIT
Begin DoDot:1
+1 SET DIC="^OOPS(2261.1,"
SET DIC(0)="LQZ"
SET DLAYGO=2261.1
+2 SET X=$PIECE(NEWCODE,";",2)
SET CODE=$PIECE(NEWCODE,";")
+3 ; don't set if code exists
if $DATA(^OOPS(2261.1,"C",CODE))
QUIT
+4 SET DIC("DR")="1////^S X=CODE"
+5 KILL DO,DD
DO FILE^DICN
KILL DLAYGO
End DoDot:1
+6 KILL CODE,DES,NEWCODE
+7 DO BMES^XPDUTL("Table updates completed.")
+8 QUIT
+9 ;
MODCODE(LINE) ; MODIFY BODY PART DESCRIPTION AND CODE
+1 ;;BA;ABDOMEN;1
+2 ;;BC;CHEST;7
+3 ;;HF;FACE;11
+4 ;;CM;MOUTH;18
+5 ;;HK;NECK;19
+6 ;;CN;NOSE, INTERNAL;20
+7 ;;BZ;EXTERNAL, EXTERNAL, OTHER;21
+8 ;;RP;PELVIS;22
+9 ;;RB;RIB;23
+10 ;;CC;SKULL (CRANIAL BONES);25
+11 ;;BL;LOWER BACK/BUTTOCKS;29
+12 ;;
NEWCODE(LINE) ; ADD NEW BODY PART CODE AND DESCRIPTION
+1 ;;AB;BOTH ARMS AND/OR WRIST
+2 ;;AS;SINGLE ARM AND/OR WRIST
+3 ;;B1;SINGLE BREAST
+4 ;;B2;BOTH BREASTS
+5 ;;B3;SINGLE TESTICLE
+6 ;;B4;BOTH TESTICLES
+7 ;;BP;PENIS
+8 ;;BS;SIDE/FLANK
+9 ;;BU;UPPER BACK
+10 ;;BW;WAIST
+11 ;;C1;SINGLE EAR
+12 ;;C2;BOTH EARS
+13 ;;C3;SINGLE EYE
+14 ;;C4;BOTH EYES
+15 ;;CB;BRAIN
+16 ;;CD;TEETH
+17 ;;CJ;JAW, MANDIBLE
+18 ;;CL;LARYNX
+19 ;;CR;THROAT, OTHER
+20 ;;CT;TONGUE
+21 ;;CZ;HEAD, INTERNAL, OTHER
+22 ;;EB;BOTH ELBOWS
+23 ;;ES;SINGLE ELBOW
+24 ;;F1;SINGLE FIRST FINGER
+25 ;;F2;BOTH FIRST FINGERS
+26 ;;F3;SINGLE SECOND FINGER
+27 ;;F4;BOTH SECOND FINGERS
+28 ;;F5;SINGLE THIRD FINGER
+29 ;;F6;BOTH THIRD FINGERS
+30 ;;F7;SINGLE FOURTH FINGER
+31 ;;F8;BOTH FOURTH FINGERS
+32 ;;G1;SINGLE GREAT TOE
+33 ;;G2;BOTH GREAT TOES
+34 ;;G3;OTH/MULT TOE(S), SINGLE FOOT
+35 ;;G4;OTH/MUTL TOE(S), BOTH FEET
+36 ;;H1;SINGLE EYE (EXTERNAL)
+37 ;;H2;BOTH EYES (EXTERNAL)
+38 ;;H3;SINGLE EAR (EXTERNAL)
+39 ;;H4;BOTH EARS (EXTERNAL)
+40 ;;HC;CHIN
+41 ;;HM;LIPS
+42 ;;HN;NOSE
+43 ;;HS;SCALP
+44 ;;KB;BOTH KNEES
+45 ;;KS;SINGLE KNEE
+46 ;;LB;BOTH LEGS/HIPS/ANKLES/BUTTOCKS
+47 ;;LS;SINGLE LEG/HIP/ANKLE/BUTTOCK
+48 ;;MB;BOTH HANDS
+49 ;;MS;SINGLE HAND
+50 ;;PB;BOTH FEET
+51 ;;PS;SINGLE FOOT
+52 ;;R1;SINGLE CLAVICLE
+53 ;;R2;BOTH CLAVICLES
+54 ;;R3;SINGLE SCAPULA
+55 ;;R4;BOTH SCAPULAE
+56 ;;RS;STERNUM
+57 ;;RV;VERTEBRA (SPINE, SPINAL COL)
+58 ;;RZ;TRUNK BONE, OTHER
+59 ;;SB;BOTH SHOULDERS
+60 ;;SS;SINGLE SHOULDER
+61 ;;TB;BOTH THUMBS
+62 ;;TS;SINGLE THUMB
+63 ;;V1;SINGLE LUNG
+64 ;;V2;BOTH LUNGS
+65 ;;V3;SINGLE KIDNEY
+66 ;;V4;BOTH KIDNEYS
+67 ;;VH;HEART
+68 ;;VL;LIVER
+69 ;;VR;REPRODUCTIVE ORGANS
+70 ;;VS;STOMACH
+71 ;;VI;Intestines
+72 ;;VZ;TRUNK, INTERNAL, OTHER
+73 ;;L4;BOTH LOWER LEG/ANKLES
+74 ;;A1;SINGLE UPPER ARM
+75 ;;A2;BOTH UPPER ARMS
+76 ;;A3;SINGLE FOREARM
+77 ;;A4;BOTH FOREARMS
+78 ;;A5;SINGLE WRIST
+79 ;;A6;BOTH WRISTS
+80 ;;AZ;ARM(S), OTHER
+81 ;;AX;ARM(S), MULTIPLE SITES
+82 ;;FS;MULTIPLE FINGERS, SINGLE HAND
+83 ;;FB;MULTIPLE FINGERS, BOTH HANDS
+84 ;;L1;SINGLE HIP/THIGH
+85 ;;L2;BOTH HIPS/THIGHS
+86 ;;L3;SINGLE LOWER LEG/ANKLE
+87 ;;LZ;LEG(S), OTHER
+88 ;;LX;LEG(S), MULTIPLE SITES
+89 ;;HZ;HEAD, EXTERNAL, OTHER
+90 ;;HX;HEAD, EXTERNAL, MULTIPLE SITES
+91 ;;CK;BONES OF FACE, OTHER(S)
+92 ;;CS;SINUS (ES)
+93 ;;CX;HEAD, INTERNAL, MULTIPLE SITES
+94 ;;B5;VULVA/VAGINA
+95 ;;BX;TRUNK, EXTERNAL, MULT SITES
+96 ;;RC;RIBS, MULTIPLE
+97 ;;RX;TRUNK, MULTIPLE BONES
+98 ;;V5;BLADDER, URETHRA
+99 ;;VC;SPINAL CORD
+100 ;;VN;NERVE
+101 ;;VM;SPLEEN
+102 ;;VX;TRUNK, INTERNAL, MULT ORGANS
+103 ;;XX;MULTIPLE ANATOMICAL SITES
+104 ;;XZ;ANATOMIC SITE NOT MENTIONED
+105 ;;
+106 QUIT
