234 lines
9.3 KiB
Mathematica
234 lines
9.3 KiB
Mathematica
OOPSGUIC ;WIOFO/LLH-RPC routine for GET/SET CA7 ;04/22/04
|
|
;;2.0;ASISTS;**8,7**;Jun 03, 2002
|
|
;
|
|
CA7LIST(RESULTS,PERSON,CALL) ; builds CA-7 selection list from existing
|
|
; cases - not an add
|
|
;
|
|
; Input: PERSON - person's SSN whether CALL="E" or "W"
|
|
; CALL - contains the calling menu and file number in the
|
|
; format FILENUM^CALL.
|
|
; Output: RESULTS - returns an array containing
|
|
; CA7 case #^IEN^DATE OF INCIDENT
|
|
K ^TMP("CA7LIST",DUZ)
|
|
N ARR,CA7,CAIEN,CALLER,ESSN,FILE
|
|
S FILE=$P($G(CALL),U),CALLER=$P($G(CALL),U,2)
|
|
I $G(PERSON)=""!($G(CALL)="")!($G(FILE)="") D Q
|
|
. S ^TMP("CA7LIST",DUZ,1)="Not enough info - can't process request"
|
|
S CAIEN=0,^TMP("CA7LIST",DUZ,1)="No CA-7's Selectable"
|
|
S ESSN=$$GET1^DIQ(200,DUZ,9)
|
|
I CALLER="E",ESSN'=PERSON D Q
|
|
.S ^TMP("CA7LIST",DUZ,1)="User SSN, file SSN do not match-form aborted"
|
|
F S CAIEN=$O(^OOPS(FILE,"SSN",PERSON,CAIEN)) Q:CAIEN="" D
|
|
.;if from emp menu & signed by both, don't give access
|
|
.I CALLER="E",$P($G(^OOPS(FILE,CAIEN,"CA7S7")),U,2)'="",($P($G(^OOPS(FILE,CAIEN,"CA7S15")),U,2)'="") Q
|
|
.I CALLER="W",(ESSN=PERSON) Q
|
|
.S CA7=$$GET1^DIQ(FILE,CAIEN,.01),ARR(CA7)=CAIEN
|
|
; drop thru here and
|
|
SORT ; reverse the order
|
|
N CN,CA7,CAIEN,DOI,NM,SSN
|
|
S ^TMP("CA7LIST",DUZ,0)="",CN=1,CA7=""
|
|
I '$D(ARR) S ^TMP("CA7LIST",DUZ,1)="No CA7's Selectable"
|
|
F S CA7=$O(ARR(CA7),-1) Q:CA7="" D
|
|
.S CAIEN=ARR(CA7)
|
|
.S ASISTS=$$GET1^DIQ(2260,$$GET1^DIQ(FILE,CAIEN,.7,"I"),52,"I")
|
|
.S ASISTS="CA-"_$G(ASISTS)
|
|
.S NM=$E($$GET1^DIQ(FILE,CAIEN,.9),1,27)
|
|
.S DOI=$$GET1^DIQ(FILE,CAIEN,7)
|
|
.S SSN=$$GET1^DIQ(FILE,CAIEN,.8)
|
|
.S ^TMP("CA7LIST",DUZ,CN)=CA7_U_DOI_U_NM_U_ASISTS_U_CAIEN_U_SSN_$C(10)
|
|
.S CN=CN+1
|
|
; then quit
|
|
S RESULTS=$NA(^TMP("CA7LIST",DUZ))
|
|
Q
|
|
LISTCA(RESULTS,INPUT) ; returns a list of valid CA (1 or 2) claims that
|
|
; can be selected to create a new CA-7
|
|
; Input: INPUT - 3 pieces to input parameter
|
|
; SSN^FILE^CALLER - CALLER contains either E
|
|
; or W (menu called from).
|
|
; FILE now only contains 2260 (for CA-1 or 2)
|
|
; Output: RESULTS - contains a array of ASISTS Claims with the
|
|
; claim number, name, and date of injury. Other
|
|
; default fields returned are, grade, step, pay amt,
|
|
; pay period, FEGLI Code, and Health Ins.
|
|
;
|
|
K ^TMP("LISTCA",DUZ)
|
|
N ARR,CAIEN,CALLER,CAIEN,CN,CNUM,DOI,FILE,INJ,NM,PAR,PDFLD,SSN
|
|
S PAR=$P($G(INPUT),U),FILE=$P($G(INPUT),U,2),CALLER=$P($G(INPUT),U,3)
|
|
I $G(PAR)=""!($G(FILE)="")!($G(CALLER)="") D Q
|
|
.S ^TMP("LISTCA",DUZ,0)="Missing parameters - cannot continue"
|
|
S CAIEN=0
|
|
F S CAIEN=$O(^OOPS(FILE,"SSN",PAR,CAIEN)) Q:CAIEN="" D
|
|
.I '$$INCLUDE() Q
|
|
.I CALLER="E",($$GET1^DIQ(200,DUZ,9)'=PAR) Q
|
|
.I CALLER="W",($$GET1^DIQ(200,DUZ,9)=PAR) Q
|
|
.S CNUM=$$GET1^DIQ(FILE,CAIEN,.01),ARR(CNUM)=CAIEN
|
|
; No cases to send back
|
|
I '$D(ARR) D Q
|
|
.S ^TMP("LISTCA",DUZ,1)="No Cases Selectable"
|
|
.S RESULTS=$NA(^TMP("LISTCA",DUZ))
|
|
; get reverse order
|
|
S CNUM="",CN=1
|
|
F S CNUM=$O(ARR(CNUM),-1) Q:CNUM="" D
|
|
.S CAIEN=ARR(CNUM)
|
|
.S NM=$$GET1^DIQ(FILE,CAIEN,1)
|
|
.S DOI=$$GET1^DIQ(FILE,CAIEN,4)
|
|
.S SSN=$TR($$GET1^DIQ(FILE,CAIEN,5),"-","")
|
|
.S GRD=$$GET1^DIQ(FILE,CAIEN,16)
|
|
.S STP=$$GET1^DIQ(FILE,CAIEN,17)
|
|
.S INJ=$$GET1^DIQ(FILE,CAIEN,52)
|
|
.S RET=$$GET1^DIQ(FILE,CAIEN,60)
|
|
.S PAY=$$GET1^DIQ(FILE,CAIEN,166)
|
|
.S PER=$$GET1^DIQ(FILE,CAIEN,167)
|
|
.; only need to do this 1 time, should never have but 1 different
|
|
.; person in this list, many claims but all for the same person
|
|
.I CN=1 S PDFLD=$$PDDEF()
|
|
.S STR=CNUM_U_DOI_U_NM_U_CAIEN_U_SSN_U_INJ_U_GRD_U_STP_U_PAY_U_PER
|
|
.S ^TMP("LISTCA",DUZ,CN)=STR_U_RET_U_PDFLD_U_DUZ_$C(10)
|
|
.S CN=CN+1
|
|
S RESULTS=$NA(^TMP("LISTCA",DUZ))
|
|
Q
|
|
INCLUDE() ; checks to make sure ok to include claim in list
|
|
N CA7OK
|
|
S CA7OK=1
|
|
; if claim not sent to DOL, can't pick
|
|
I $$GET1^DIQ(FILE,CAIEN,67)="" S CA7OK=0
|
|
; if deleted, replaced by amendment - can't pick
|
|
I $$GET1^DIQ(FILE,CAIEN,51,"I")>1 S CA7OK=0
|
|
Q (CA7OK)
|
|
PDDEF() ; get Fegli Code and Health insurance fields from paid
|
|
N CNT,FEG,FEG1,INS,INS1,PAID
|
|
S (FEG,FEG1,INS,INS1)=""
|
|
D FIND^DIC(450,,"@;226EI;231I","MPSC",SSN,10,"SSN")
|
|
I $G(DIERR) D CLEAN^DILF Q FEG_U_INS
|
|
I $P(^TMP("DILIST",$J,0),U)=0 Q FEG_U_INS
|
|
S PAID=$G(^TMP("DILIST",$J,1,0)),FEG=$P(PAID,U,3)
|
|
; if A0 - ineligible, B0 - waived therefore No
|
|
I FEG="A0"!(FEG="B0") S FEG1="N;"
|
|
; if C0 - only Basic
|
|
I FEG="C0" S FEG1="Y;"
|
|
; has Fegli, but not basic, additional, get additional code
|
|
I $G(FEG1)="",($L($P(PAID,U,2),"Basic +")>1) S FEG1="Y;"_FEG
|
|
; now deal with insurance
|
|
S INS=$P(PAID,U,4)
|
|
; if INS = 000, 001, 002, 003 they don't have insurance
|
|
I (INS?.N)&(+INS<4) S INS1="N;"
|
|
; otherwise they do, get the code
|
|
I $G(INS1)="" S INS1="Y;"_INS
|
|
Q INS1_U_FEG1
|
|
MULTIPLE(RESULTS,INPUT,DATA) ; retrieve data from multiple
|
|
; NOTE: When filing into subrecord, the entire subrecord is deleted
|
|
; then rebuilt. Also, the field number for the subrecord
|
|
; must be passed with the data.
|
|
; WORD PROCESSING fields CANNOT file using this code
|
|
; Input: INPUT - in the format FILE^FIELD^IEN
|
|
; DATA - array of data in the format
|
|
; DATA(SIEN)=data where data = P1^P2^P3 etc, where
|
|
; P1 = subfield #;data
|
|
; DATA="" must be true for a GET.
|
|
; Output: RESULTS - data from all records in the multiple will
|
|
; be returned. it will be saved in a pieced
|
|
; string.
|
|
N ACTION,ARR,IEN,FIELD,FILE,ROOT,SAVEDIK,SPEC,SUB
|
|
S FILE=$P($G(INPUT),U),FIELD=$P($G(INPUT),U,2),IEN=$P($G(INPUT),U,3)
|
|
S ACTION="" I $D(DATA)>1 S ACTION=1
|
|
S RESULTS(0)="Record Accessed, no data"
|
|
I $G(IEN)=""!($G(FILE)="")!($G(FIELD)="") D Q
|
|
. S RESULTS(0)="Invalid parameters cannot continue"
|
|
S ROOT=$$ROOT^DILFD(FILE,0,"GL")
|
|
S SPEC=+$$GET1^DID(FILE,FIELD,"","SPECIFIER")
|
|
S SUB=$$GET1^DID(FILE,FIELD,"","GLOBAL SUBSCRIPT LOCATION")
|
|
I '$$GET1^DID(FILE,FIELD,"","MULTIPLE-VALUED"),'$G(SPEC) D Q
|
|
. S RESULTS(1)="Field in not a multiple, cannot continue"
|
|
; now go get data from subfile
|
|
S SAVEDIK=ROOT_IEN_","_$C(34)_$P(SUB,";")_$C(34)_","
|
|
I 'ACTION D GETD
|
|
I ACTION D KILLD,SETD
|
|
Q
|
|
GETD ; get the data
|
|
N CNT,DATA,FLDA,FLDS,IENS,SIEN,SFLD,SREC,TYPE
|
|
S CNT=0,IENS=IEN_","
|
|
S FLDA=FIELD_"*"
|
|
; hate to hardwire, but need data back as entered, not canonical
|
|
I FILE=2262.03,FIELD=15 D FLD15 Q
|
|
D GETS^DIQ(FILE,IENS,FLDA,,"ARR")
|
|
I $D(ARR) S SIEN="",RESULTS(0)="" D
|
|
.F S SIEN=$O(ARR(SPEC,SIEN)) Q:SIEN="" D
|
|
..S SFLD="",SREC=$P(SIEN,",")
|
|
..F S SFLD=$O(ARR(SPEC,SIEN,SFLD)) Q:SFLD="" D
|
|
...S DATA=ARR(SPEC,SIEN,SFLD)_U
|
|
...S:$D(RESULTS(CNT))=0 RESULTS(CNT)=""
|
|
...S RESULTS(CNT)=RESULTS(CNT)_DATA
|
|
..S CNT=CNT+1
|
|
Q
|
|
KILLD ; first kill all records in subfile, then rebuild
|
|
N DA,DIK,NODE
|
|
S NODE=$P(SUB,";"),DA=0,DA(1)=IEN,DIK=SAVEDIK
|
|
F S DA=$O(@(ROOT_"DA(1),NODE,DA)")) Q:(+DA'>0) D ^DIK
|
|
Q
|
|
SETD ; subrecord cleaned out, now rebuild
|
|
N BAD,CN,DR,DIE,DA,DLAYGO,I,NUM,STR,DIC,TYPE
|
|
K DR
|
|
S RESULTS(0)="Filing successful"
|
|
S CN=0,DLAYGO=FILE,DA(1)=IEN,DIC=SAVEDIK,DIC(0)="L"
|
|
F S CN=$O(DATA(CN)) Q:CN'>0 S X="",BAD=0 D
|
|
.S STR=DATA(CN),NUM=$L(DATA(CN),U),DIC("DR")=""
|
|
.F I=1:1:NUM S STR1=$P($G(STR),U,I) D:('BAD)
|
|
..I $P(STR1,";")=.01,$P(STR1,";")="",$P(STR1,";",2)="" S BAD=1 Q
|
|
..I $P(STR1,";")=.01 D
|
|
...S TYPE=$$GET1^DID(SPEC,.01,"","TYPE")
|
|
...I TYPE="DATE/TIME" S X=$$FMTE^XLFDT($P(STR1,";",2),2)
|
|
...E S X=$P(STR1,";",2)
|
|
..S DIC("DR")=DIC("DR")_$P(STR1,";")_"///"_$P(STR1,";",2)_";"
|
|
.D MFILE
|
|
Q
|
|
MFILE ; file the multiple
|
|
N PCE,PCE1,TMP
|
|
I X="" S RESULTS(0)=".01 field missing - could not file" Q
|
|
I $G(BAD) S RESULTS(0)="Problems Filing subrecord" Q
|
|
I $L(DIC("DR"))>240 D
|
|
.S PCE=$L(DIC("DR"),";"),TMP=DIC("DR"),PCE1=$P(PCE/2,".")
|
|
.S DIC("DR")=$P(TMP,";",1,PCE1)
|
|
.K DD,DO D FILE^DICN I Y'>0 S BAD=1
|
|
.S DIC("DR")=$P(TMP,";",(PCE1+1),PCE)
|
|
K DD,DO D FILE^DICN I Y'>0 S BAD=1
|
|
I BAD S RESULTS(0)="Problems filing subrecord"
|
|
Q
|
|
OSHA300(RESULTS,STA,DATA) ; Files data into subrecord 2262.315
|
|
; Input - STA is the station number subrecord IEN
|
|
; DATA is an number subscripted array containing the records
|
|
; that contain the Emp Numbers and hours worked in the
|
|
; OSHA MONTH/YEAR subrecord.
|
|
; Output - RESULTS indicating the success of the filing.
|
|
;
|
|
N CNT,IENS,FILE,OSHAFDA,LV1,LV2,PAR,REC,STR
|
|
S CNT=1,FILE=2262.315
|
|
S PAR="^OOPS(2262,0)",PAR=$Q(@PAR),PAR=$Q(@PAR)
|
|
S LV1=$P(PAR,",",2),LV2=$P(PAR,",",3)
|
|
S RESULTS=""
|
|
I $D(DATA)<10 S RESULTS="NO DATA TO FILE, CANNOT CONTINUE" Q
|
|
I '$G(STA) S RESULTS="NOT ENOUGH PARAMETERS, COULDN'T FILE" Q
|
|
I '$D(^OOPS(2262,LV1,LV2,STA)) D Q
|
|
.S RESULTS="NO STATION RECORD, COULDN'T FILE"
|
|
K ^OOPS(2262,LV1,LV2,STA,2)
|
|
S REC=0 F S REC=$O(DATA(REC)) Q:REC="" D
|
|
.S IENS="?+"_CNT_","_STA_","_LV1_","
|
|
.S STR=DATA(REC)
|
|
.S OSHAFDA(FILE,IENS,.01)=$P($P(STR,U,1),";",2)
|
|
.S OSHAFDA(FILE,IENS,1)=$P($P(STR,U,2),";",2)
|
|
.S OSHAFDA(FILE,IENS,2)=$P($P(STR,U,3),";",2)
|
|
.S CNT=CNT+1
|
|
D UPDATE^DIE("E","OSHAFDA","IENS","MSG")
|
|
I '$D(MSG) S RESULTS="Filing Successful"
|
|
K MSG,STR,Y,X,%DT
|
|
Q
|
|
FLD15 ; retrieves OSHA 300A Summary data from file 2262
|
|
N CNT,DATE,LV1,LV2,PAR,REC
|
|
S CNT=0,PAR="^OOPS(2262,0)",PAR=$Q(@PAR),PAR=$Q(@PAR)
|
|
S LV1=$P(PAR,",",2),LV2=$P(PAR,",",3),IENS=$P(IEN,",",1),REC=0
|
|
F S REC=$O(^OOPS(2262,LV1,LV2,IENS,2,REC)) Q:REC'>0 D
|
|
.S STR=$G(^OOPS(2262,LV1,LV2,IENS,2,REC,0))
|
|
.S Y=$P(STR,U,1) D DD^%DT
|
|
.S RESULTS(CNT)=Y_U_$P(STR,U,2,3)
|
|
.S CNT=CNT+1
|
|
Q
|