Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OOPSXP8

OOPSXP8.m

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