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

OOPSGUI4.m

Go to the documentation of this file. 
  1. OOPSGUI4 ;WIOFO/LLH-RPC BROKER CALLS ;10/02/01
  1.  ;;2.0;ASISTS;**4,8,7,11,15,18,21**;Jun 03, 2002;Build 7
  1.  ;
  1.  ;  Input:    NAME - the Employee or partial Name Passed in
  1.  ; Output: RESULTS - array containing PAID fields in the order returned
  1.  ;                   from FIND^DIC
  1.  ;
  1.  N IEN200,LP,PAY,PAYP,PHONE,OCCDESC,RET,SAL,SSN,X,STATE,SERV,SAMEFLG
  1.  N IEN450,TERM
  1.  I NAME="" S RESULTS(1)="^NO SSN OR NAME PROVIDED" Q
  1.  S X=NAME,SAMEFLG=0
  1.  D FIND^DIC(450,,"@;.01;6;8;10;13;16EI;31;32;38;186.1;186.2;186;186.4;458I;30","MPS",X,500)
  1.  I $G(DIERR) D CLEAN^DILF Q
  1.  I $P(^TMP("DILIST",$J,0),U)=0 S RESULTS(0)="^NO PAID EMPLOYEE FOUND" Q
  1.  F LP=0:0 S LP=$O(^TMP("DILIST",$J,LP)) Q:LP=""  D
  1.  .; cannot pick yourself if selecting case,use SSN to see if DUZ matches
  1.  .S SSN=$TR($P($G(^TMP("DILIST",$J,LP,0)),U,4),"-","")
  1.  .I $G(SSN) S IEN200=$O(^VA(200,"SSN",SSN,""))
  1.  .; 12/29/03 llh - also cannot pick a person from the PAID file with
  1.  .;                a pseudo SSN (one that begins with 000)
  1.  .I $E(SSN,1,3)="000" Q
  1.  .I DUZ=IEN200 S SAMEFLG=1 Q
  1.  .;V2_P18 expand logic, check for future date - if termination date not beyond today include
  1.  .S TERM=$$GET1^DIQ(200,IEN200,9.2,"I") I $G(TERM) Q:($$FMDIFF^XLFDT(TERM,$$DT^XLFDT)<0)
  1.  .;V2_P15 - moved/modified next line up from below & if separated from PAID, Q
  1.  .S IEN450=$P(^TMP("DILIST",$J,LP,0),U)
  1.  .I $$GET1^DIQ(450,IEN450,80,"I")="Y" Q
  1.  .S RESULTS(LP)=^TMP("DILIST",$J,LP,0)
  1.  .S $P(RESULTS(LP),U,5)=$E($P(RESULTS(LP),U,5),1,45)
  1.  .;V2_P15 restrict output of OCCUPATION SERIES & TITLE to 30 characters
  1.  .S $P(RESULTS(LP),U,7)=$E($P(RESULTS(LP),U,7),1,30)
  1.  .S $P(RESULTS(LP),U,8)=$E($P($G(RESULTS(LP)),U,8),1,4)
  1.  .S PHONE=""  ; ,SSN=$TR($P($G(RESULTS(LP)),U,4),"-","")
  1.  .I $G(IEN200) S PHONE=$P($G(^VA(200,IEN200,.13)),U)
  1.  .I $TR(PHONE,"(,)-^*/# &%@!","")'?10N S PHONE=""  ;Must be 10 char
  1.  .S RESULTS(LP)=RESULTS(LP)_U_PHONE
  1.  .I $G(IEN450) D
  1.  ..S PAYP=$$GET1^DIQ(450,IEN450,20) I $G(PAYP)'="" S PAYP=$$PAYP^OOPSUTL1(PAYP)
  1.  ..S SAL=$$GET1^DIQ(450,IEN450,28)
  1.  ..S RET=$$GET1^DIQ(450,IEN450,26) I $G(RET)'="" S RET=$S(RET="FULL CSRS":"CSRS",RET="FERS":"FERS",1:"OTHER")
  1.  ..S PAY=$$GET1^DIQ(450,IEN450,19) I $G(PAY)'="" S PAY=$S(PAY="PER ANNUM":"ANNUAL",PAY="PER HOUR":"HOURLY","PER DIEM":"DAILY","BIWEEKLY":"BI-WEEKLY",1:"")
  1.  ..S OCCDESC=$E($$GET1^DIQ(450,IEN450,16),1,30)
  1.  .S SERV="" I $G(IEN200) S SERV=$$GET1^DIQ(200,IEN200,29)
  1.  .S RESULTS(LP)=RESULTS(LP)_U_PAY_U_SAL_U_RET_U_PAYP_U_OCCDESC_U_SERV
  1.  I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
  1.  KILL DIERR,^TMP("DILIST",$J)
  1.  Q
  1. ASISTS(RESULTS,NAME) ; Lookup on ASISTS Accident Reporting file_2260
  1.  ;  Input:  - Name or partial name of person to lookup on
  1.  ; Output:  - array with name of person, sex, DOB, and SSN
  1.  N ARR,I,X,SAMEFLG
  1.  K ^TMP("DILIST",$J)
  1.  I NAME="" S RESULTS(0)="^NO SSN OR NAME PROVIDED" Q
  1.  S X=NAME,SAMEFLG=0
  1.  D FIND^DIC(2260,,"@;1;7;6;5","PSMC",X,500,"C^SSN^BS5")
  1.  I $G(DIERR) D CLEAN^DILF Q
  1.  I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO ASISTS CASE FOUND" Q
  1.  F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I=""  D
  1.  .I DUZ=$P(^TMP("DILIST",$J,I,0),U) S SAMEFLG=1 Q
  1.  .I $D(ARR($P(^TMP("DILIST",$J,I,0),U,2))) Q
  1.  .S ARR($P(^TMP("DILIST",$J,I,0),U,2))=""
  1.  .S RESULTS(I)=^TMP("DILIST",$J,I,0)
  1.  I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
  1.  I '$D(RESULTS) S RESULTS(0)="^NO SELECTABLE CASES FOUND"
  1.  K DIERR,^TMP("DILIST",$J)
  1.  Q
  1. PER(RESULTS,NAME) ; Lookup for Non-Paid Employee (New Person file_
  1.  ;  Input:  - Name or partial name of person to lookup on
  1.  ; Output:  - array with name of new person, sex, DOB, and SSN
  1.  N I,SSN,X,SAMEFLG,IEN200
  1.  K ^TMP("DILIST",$J)
  1.  I NAME="" S RESULTS(0)="^NO SSN OR NAME PROVIDED" Q
  1.  S X=NAME,SAMEFLG=0
  1.  D FIND^DIC(200,,"@;.01;4;5;9;29","PSMC",X,500)
  1.  I $G(DIERR) D CLEAN^DILF Q
  1.  I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO NEW PERSON FOUND" Q
  1.  F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I=""  D
  1.  .; make sure not a PAID Employee
  1.  .S SSN=$P(^TMP("DILIST",$J,I,0),U,5)
  1.  .I $G(SSN),$$FIND1^DIC(450,"","MX",SSN) Q
  1.  .;V2_P15 modified for HD0000000152026
  1.  .S IEN200=$P(^TMP("DILIST",$J,I,0),U)
  1.  .I DUZ=IEN200 S SAMEFLG=1 Q
  1.  .;V2_P18 expand logic, check for future date - if termination date not beyond today include
  1.  .S TERM=$$GET1^DIQ(200,IEN200,9.2,"I") I $G(TERM) Q:($$FMDIFF^XLFDT(TERM,$$DT^XLFDT)<0)
  1.  .S RESULTS(I)=^TMP("DILIST",$J,I,0)
  1.  I SAMEFLG,'$D(RESULTS) S RESULTS(0)="^CANNOT CREATE CASE FOR YOURSELF"
  1.  I '$D(RESULTS) S RESULTS(0)="^NO SELECTABLE CASES FOUND"
  1.  K DIERR,^TMP("DILIST",$J)
  1.  Q
  1. SUPER(RESULTS,NAME,EMPSSN) ; Lookup for Supervisors or anyone from the New 
  1.  ;                 Person file.  Broker call will also be used to
  1.  ;                 lookup Union Reps for the Enter/Edit Union Information.
  1.  ;  Input:    NAME - Name or partial name of person to lookup on
  1.  ;             SSN - SSN of the Person Involved if called from 2162
  1.  ; Output: RESULTS - array with name of new person, sex, DOB, and SSN
  1.  N I,SSN,SAME,STR,X
  1.  K ^TMP("DILIST",$J)
  1.  I NAME="" S RESULTS(1)="^NO SSN OR NAME PROVIDED" Q
  1.  S X=NAME,SAME=0
  1.  D FIND^DIC(200,,".01;9","PSCM",X,500)
  1.  I $G(DIERR) D CLEAN^DILF Q
  1.  I $P(^TMP("DILIST",$J,0),"^")=0 S RESULTS(1)="^NO NEW PERSON FOUND" Q
  1.  F I=0:0 S I=$O(^TMP("DILIST",$J,I)) Q:I=""  D
  1.  .S STR=$G(^TMP("DILIST",$J,I,0))
  1.  .;Remedy Ticket: HD0000000311261 expand logic, check for future date - if term. date not beyond 
  1.  .;today include. This changed logic from patch 15, was if terminated don't include
  1.  .S TERM=$$GET1^DIQ(200,$P(STR,U,1),9.2,"I") I $G(TERM) Q:($$FMDIFF^XLFDT(TERM,$$DT^XLFDT)<0)
  1.  .I $G(EMPSSN)'="",($P(STR,U,3)=$G(EMPSSN)) S SAME=1 Q
  1.  .S RESULTS(I)=STR
  1.  I SAME,'$D(RESULTS) S RESULTS(1)="^CANNOT BE SUPERVISOR FOR YOUR CLAIM"
  1.  I '$D(RESULTS) S RESULTS(1)="^NO VALID SELECTION"
  1.  K DIERR,^TMP("DILIST",$J)
  1.  Q
  1.  ;
  1. LOAD(RESULTS,ARR) ; Create new OOPS record
  1.  ;  Input:     ARR  - contains data entered from the Create Incident
  1.  ;                    Report Option
  1.  ; Output:  RESULTS - status message
  1.  ;
  1.  N ASUB,CAT,DA,DATE,DIC,DR,ERROR,FLDS,FNUM,FYEAR,IEN2260,LP,NUM,PCE,SSN,X
  1.  N LIST,CNT,DLAYGO
  1.  S CAT=""
  1.  I $G(ARR(2)) S CAT=ARR(2)
  1.  I $G(ARR(5)) S SSN=ARR(5)
  1.  D NOW^%DTC
  1.  S DATE=X
  1.  S FYEAR=""
  1.  S FYEAR=$$FYEAR^OOPSCSN(X)
  1.  S NUM=$$NEWR^OOPSCSN(FYEAR)
  1.  K DD,DO
  1.  S DLAYGO=2260,DIC="^OOPS(2260,"
  1.  S DIC(0)="QLZ"
  1.  S X=NUM
  1.  D FILE^DICN
  1.  I Y<0 S (RESULTS,RESULTS(0))="UNABLE TO CREATE RECORD" Q
  1.  S IEN2260=+Y
  1.  S DIE="^OOPS(2260,"
  1.  S DA=IEN2260
  1.  S LIST="1,2,3,4,5,6,7,8,9,10,11,12,14,15,16,17,18,52,60,63,86,90,335,"
  1.  S LIST=LIST_"336,338,339,349,350,351,352,"
  1.  I ARR(52)="Injury" S LIST=LIST_",111,166,167"
  1.  I ARR(52)="Illness/Disease" S LIST=LIST_",208,334"
  1.  F CNT=1:1 S FNUM=$P(LIST,",",CNT) Q:FNUM=""  I $G(ARR(FNUM))'="" D VAL(DA,FNUM,ARR(FNUM))
  1.  K DR S DIE="^OOPS(2260,",DA=IEN2260,DR=""
  1.  S DR(1,2260,1)="1///^S X=ARR(1)"
  1.  S DR(1,2260,2)="2///^S X=ARR(2)"
  1.  S DR(1,2260,3)="3///^S X=ARR(3)"
  1.  S DR(1,2260,4)="4///^S X=ARR(4)"
  1.  S DR(1,2260,5)="5///^S X=ARR(5)"
  1.  S DR(1,2260,6)="6///^S X=ARR(6)"
  1.  S DR(1,2260,7)="7///^S X=ARR(7)"
  1.  S DR(1,2260,8)="8///^S X=ARR(8)"
  1.  S DR(1,2260,9)="9///^S X=ARR(9)"
  1.  S DR(1,2260,10)="10///^S X=ARR(10)"
  1.  S DR(1,2260,12)="11///^S X=ARR(11)"
  1.  S DR(1,2260,15)="12///^S X=ARR(12)"
  1.  S DR(1,2260,18)="13////^S X=ARR(13)"
  1.  S DR(1,2260,21)="14///^S X=ARR(14)"
  1.  S DR(1,2260,24)="15///^S X=ARR(15)"
  1.  S DR(1,2260,27)="16///^S X=ARR(16)"
  1.  S DR(1,2260,30)="17///^S X=ARR(17)"
  1.  S DR(1,2260,33)="18///^S X=ARR(18)"
  1.  S DR(1,2260,36)="52///^S X=ARR(52)"
  1.  S DR(1,2260,39)="53////^S X=ARR(53)"
  1.  S DR(1,2260,42)="53.1////^S X=ARR(22)"
  1.  S DR(1,2260,45)="56////^S X=ARR(48)"
  1.  S DR(1,2260,48)="60///^S X=ARR(60)"
  1.  S DR(1,2260,51)="63///^S X=ARR(63)"
  1.  S DR(1,2260,54)="86///^S X=ARR(86)"
  1.  S DR(1,2260,57)="90///^S X=ARR(90)"
  1.  S DR(1,2260,58)="335///^S X=ARR(169)"
  1.  S DR(1,2260,59)="336///^S X=ARR(170)"
  1.  I ARR(52)="Injury" D
  1.  .S DR(1,2260,60)="111///^S X=ARR(19)"
  1.  .S DR(1,2260,63)="166///^S X=ARR(166)"
  1.  .S DR(1,2260,67)="167///^S X=ARR(167)"
  1.  I ARR(52)="Illness/Disease" D
  1.  .S DR(1,2260,60)="208///^S X=ARR(19)"
  1.  .S DR(1,2260,61)="334///^S X=ARR(168)"
  1.  ; patch 11 - new OSHA 300 questions
  1.  S DR(1,2260,70)="349///^S X=ARR(171)"
  1.  S DR(1,2260,71)="339///^S X=ARR(172)"
  1.  S DR(1,2260,72)="338///^S X=ARR(173)"
  1.  S DR(1,2260,73)="350///^S X=ARR(174)"
  1.  S DR(1,2260,74)="351///^S X=ARR(175)"
  1.  S DR(1,2260,75)="352///^S X=ARR(176)"
  1.  ; V2P15 new field
  1.  S DR(1,2260,76)="360///^S X=ARR(177)"
  1.  D ^DIE
  1.  ;V2_P15 - if INITIAL RETURN TO WORK STATUS = Days Away work or Job Transfer/Restriction
  1.  ;send a new bulletin
  1.  I ARR(176)="DAYS AWAY WORK"!(ARR(176)="Job Transfer/Restriction") D CIO^OOPSMBUL(IEN2260)
  1.  D CASE^OOPSMBUL(IEN2260) D:(CAT=1)!(CAT=6) BOR^OOPSMBUL(IEN2260):$D(^VA(200,"SSN",SSN))
  1.  K DR S DIE="^OOPS(2260,",DA=IEN2260,DR="51///0" D ^DIE
  1.  K DIE,DR,DA
  1.  S (RESULTS,RESULTS(1))="OK" S:$G(ERROR)]"" (RESULTS,RESULTS(1))=ERROR
  1.  S RESULTS(2)=$P(^OOPS(2260,IEN2260,0),"^")
  1.  Q
  1. DELETE ;Delete incomplete case
  1.  N DIK,DA
  1.  S DIK="^OOPS(2260,",DA=IEN2260
  1.  D ^DIK
  1.  Q
  1. VAL(DA,FIELD,VALUE) ;Validate Input
  1.  ;  Input:   DA  - IEN of the ASISTS record
  1.  ;        FIELD  - field number for data to be validated
  1.  ;        VALUE  - data to be validated
  1.  ; Output:  none
  1.  N X
  1.  D VAL^DIE(2260,DA,FIELD,"",VALUE,.X)
  1.  I X=U D
  1.  .S:$G(ERROR)]"" ERROR=ERROR_","
  1.  .S ERROR=$G(ERROR)_$$GET1^DID(2260,FIELD,"","LABEL")_U_VALUE
  1.  .; set the data to nil so filing will not bomb
  1.  .S ARR(FIELD)=""
  1.  Q
  1. DUP(RESULTS,SSN) ; Duplicate Case error checking broker call
  1.  ;  Input:    INPUT - SSN of current ASISTS case number
  1.  ; Output:  RESULTS - return array with case information
  1.  ;
  1.  N CN,DT,IEN,NM,TYPE
  1.  S IEN="",CN=0
  1.  S RESULTS(CN)="NO MATCHES FOUND"
  1.  F  S IEN=$O(^OOPS(2260,"SSN",SSN,IEN)) Q:IEN=""  D
  1.  .I $$GET1^DIQ(2260,IEN,51,"I") Q        ;case not open, don't include
  1.  .S NM=$$GET1^DIQ(2260,IEN,1)
  1.  .S TYPE=$$GET1^DIQ(2260,IEN,"3:.01")
  1.  .S DT=$$GET1^DIQ(2260,IEN,4)
  1.  .S RESULTS(CN)=NM_"  "_DT_"  "_TYPE
  1.  .S CN=CN+1,(NM,TYPE,DT)=""
  1.  Q