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

OOPSGUIC.m

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