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

OOPSGUI8.m

Go to the documentation of this file. 
  1. OOPSGUI8 ;WIOFO/LLH-RPC Broker calls for GUI ;10/23/01
  1.  ;;2.0;ASISTS;**8,7,11,15,21**;Jun 03, 2002;Build 7
  1.  ;
  1. EN1(RESULTS,INPUT) ; Entry point for routine
  1.  ;  Input:  INPUT contains the IEN of the ASISTS record and the 
  1.  ;          calling menu, in the format IEN^CALLING MENU
  1.  ; Output:  RESULTS contains status messages back to the client. 
  1.  ;          RESULTS(0) will = either 1 or 0.  1 if ok for form to be
  1.  ;          signed by calling menu option, 0 if not ok.  The RESULTS
  1.  ;          array with status message will start at 1.
  1.  ;
  1.  N CALL,CN,DIC,IEN,FORM,PRM1,PRM2,SIGN,Y
  1.  S CN=1
  1.  S IEN=$P($G(INPUT),U),CALL=$P($G(INPUT),U,2)
  1.  S FORM=$$GET1^DIQ(2260,IEN,52,"I")
  1.  S FORM=$S(FORM=1:"CA1",FORM=2:"CA2",1:"")
  1.  S PRM1=$S(CALL="O":"Safety Officer",CALL="H":"Occupational Health",1:0)
  1.  S PRM2=PRM1_" approves the WCP signing for the Employee: "
  1.  S SIGN=""
  1.  I '$G(IEN)!($G(FORM)="")!($G(CALL)="") D  Q
  1.  . S RESULTS(0)=0
  1.  . S RESULTS(1)="Missing Information, Cannot Continue"
  1.  I CALL="W" G WCPS4E
  1.  S RESULTS(0)=$$VALID()
  1.  I RESULTS(0) S RESULTS(CN)=PRM2,CN=CN+1
  1.  G EXIT
  1. WCPS4E ; allow WCP to sign for employee if all approvals given
  1.  N CONT,EHS,SIGN,SOS,VALID,VIEW
  1.  S SIGN=0,VALID=0,VIEW=1
  1.  ; V2_P15 - all code related to safety and occ health signing is obsolete, commented out
  1.  ;S SOS=$$GET1^DIQ(2260,IEN,76,"I")
  1.  ;S EHS=$$GET1^DIQ(2260,IEN,79,"I")
  1.  ;S CONT=$S(DUZ=SOS:"S",DUZ=EHS:"H",1:"")
  1.  ;I (CONT="S")!(CONT="H") D
  1.  ;. S RESULTS(CN)="You have approved as "_$S(CONT="S":"Safety Officer",CONT="H":"Occ Health Rep",1:"")
  1.  ;. S RESULTS(CN)=RESULTS(0)_" and cannot sign as Employee.",CN=CN+1
  1.  ;. S RESULTS(CN)="Three different individuals must be involved."
  1.  ;. S VIEW=0
  1.  ;I '$G(SOS) S VIEW=0 D
  1.  ;. S RESULTS(CN)="Safety Officer has not approved WCP signing for employee.",CN=CN+1
  1.  ;I '$G(EHS) S VIEW=0 D
  1.  ;. S RESULTS(CN)="Occupational Health has not approved WCP signing for employee.",CN=CN+1
  1.  I VIEW D
  1.  . ; Allow clearing WCP signature, employee may be able to sign
  1.  . I $$GET1^DIQ(2260,IEN,119,"I") D CLRES^OOPSUTL1(IEN,"E",FORM)
  1.  . ;V2P15 - needed to change the logic in the remaining code due to new functionality where
  1.  . ;        Safety and Occ Health do not need to approve prior to WC signing for employee.
  1.  . ;        Must now check required fields are completed before letting WC sign.
  1.  . ;D VALIDATE^OOPSUTL4(IEN,FORM,"E",.VALID)
  1.  . ;V2_P15 llh - modifed for patch 15 - RESULTS will contain the list of invalid fields if any
  1.  . ;             from OOPSGUI9.  If all fields ok, set RESULTS(0) to indicate that by setting =1
  1.  . S RESULTS(0)="The following required fields must be completed before signing"
  1.  . D VALIDATE^OOPSGUI9(IEN,FORM,"E",.VALID)
  1.  . ;09/15/09 - v2_P21 remedy ticket 300258 - put next line back in - took out ;
  1.  . I 'VALID S RESULTS(CN)="All required fields not completed",CN=CN+1 Q
  1.  . I VALID S RESULTS(0)=1
  1.  . I CALL="W" N CALLER S CALLER="E"
  1.  . D EMP^OOPSVAL1
  1. EXIT ;
  1.  Q
  1. VALID() ; make sure same person is not signing for both safety and EH and if
  1.  ; signed from menu option being called not needed again - so quit
  1.  N CONT,EHAPP,ERR,SOAPP,VALID
  1.  S VALID=1,ERR=0
  1.  ;
  1.  S SOAPP=$P($G(^OOPS(2260,IEN,"WCSE")),U)
  1.  S EHAPP=$P($G(^OOPS(2260,IEN,"WCSE")),U,4)
  1.  S CONT=$S(DUZ=SOAPP:"S",DUZ=EHAPP:"H",1:"")
  1.  I CALL="O" D
  1.  . I CONT="S" S ERR=1
  1.  . I $G(EHAPP)=DUZ S ERR=2
  1.  . I $G(SOAPP)&($G(CONT)="") S ERR=3
  1.  I CALL="H" D
  1.  . I CONT="H" S ERR=1
  1.  . I $G(SOAPP)=DUZ S ERR=2
  1.  . I $G(EHAPP)&($G(CONT)="") S ERR=3
  1.  I ERR=1 D
  1.  . S RESULTS(CN)="You have signed as "
  1.  . S RESULTS(CN)=RESULTS(CN)_PRM1
  1.  . S RESULTS(CN)=RESULTS(CN)_", Cannot sign."
  1.  . S CN=CN+1,VALID=0
  1.  I ERR=2 D
  1.  . S RESULTS(CN)="You have already signed as "
  1.  . S RESULTS(CN)=RESULTS(CN)_$S(CALL="O":"Occupational Health",CALL="H":"Safety Officer",1:0)_".",CN=CN+1
  1.  . S RESULTS(CN)="Both signatures cannot be made by the same person."
  1.  . S CN=CN+1,VALID=0
  1.  I ERR=3 D
  1.  . S RESULTS(CN)=PRM1_" has already signed, re-signing is not required."
  1.  . S CN=CN+1,VALID=0
  1.  Q VALID
  1. CSIGN(RESULTS,IEN,FORM,CALL) ; Clears Signature from form
  1.  ;
  1.  ;   Input:     IEN - IEN of the ASISTS case to have the
  1.  ;                    signature cleared from
  1.  ;             FORM - the Form to clear the signature from, 2162,
  1.  ;                    CA1 or CA2 or CA7 (CA7 added V2 patch 5)
  1.  ;             CALL - the calling menu
  1.  ;  Output: RESULTS - single value with status message
  1.  ;
  1.  S RESULTS="Clearing Signatures"
  1.  I ('$G(IEN))!($G(FORM)="")!($G(CALL)="") S RESULTS="FAILED"
  1.  ; V2 Patch 5 llh - added logic for CA7
  1.  I FORM'="CA7" D CLRES^OOPSUTL1(IEN,CALL,FORM)
  1.  I FORM="CA7" D CLRES^OOPSGUIS(IEN,CALL,FORM)
  1.  S RESULTS="CLEARED"
  1.  Q
  1. DTFC(RESULTS,DATE,FLAG) ; Reformat Date/Time
  1.  ;  Input  - Date to be reformatted
  1.  ;         - Flag to be used
  1.  ; Output  - RESULTS contains the reformatted date
  1.  ;
  1.  N X,%DT            ; patch 11 - added %DT
  1.  S FLAG=+$G(FLAG)
  1.  I DATE=""!(FLAG="") S (RESULTS,RESULTS(1))="" Q
  1.  S X=DATE,%DT="T" D ^%DT
  1.  S DATE=Y,X="NOW"
  1.  D ^%DT
  1.  I $S(DATE=-1:1,FLAG<0:Y<DATE,FLAG>0:DATE>Y,1:0) S DATE=-1
  1.  I DATE=-1 S (RESULTS,RESULTS(1))="DATE ERROR" Q
  1.  S (RESULTS,RESULTS(1))=$$FMTE^XLFDT(DATE,5)
  1.  Q
  1. GETNOI(RESULTS,OPT) ; Broker Call to retrieve NOI Codes
  1.  ;  Input:     OPT - Either CA1 or CA2 to indicate which codes should be
  1.  ;                   retrieved.  If CA1 must start with T, otherwise CA2
  1.  ; Output: RESULTS - NOI Description and Code
  1.  N NOI,DES,CODE,CN
  1.  S DES="",CN=0
  1.  F  S DES=$O(^OOPS(2263.3,"B",DES)) Q:DES=""  S NOI="" F  S NOI=$O(^OOPS(2263.3,"B",DES,NOI)) Q:NOI=""  D
  1.  . S CODE=$P(^OOPS(2263.3,NOI,0),U,2)
  1.  . I OPT="CA1",($E(CODE,1)="T") S RESULTS(CN)=NOI_":"_DES_" - "_CODE
  1.  . I OPT="CA2",($E(CODE,1)'="T") S RESULTS(CN)=NOI_":"_DES_" - "_CODE
  1.  . S CN=CN+1
  1.  Q
  1. ZIPCHK(RESULTS,DATA) ; patch 5 - validate zip code against file 5.12
  1.  ;                 to ensure zip in file and has correct state.
  1.  ;
  1.  ;  Input:    DATA - contains ZIP CODE^STATE NAME
  1.  ; Output: RESULTS - returns message with validation results
  1.  ;
  1.  N STATE,VALSTATE,VALZIP,ZIP,ZZIP
  1.  S ZIP=$P($G(DATA),U,1),STATE=$P($G(DATA),U,2)
  1.  S RESULTS=""
  1.  I '$G(ZIP)!($G(STATE)="") S RESULTS="MISSING PARAMETERS" Q
  1.  D POSTAL^XIPUTIL(ZIP,.ZZIP)
  1.  I $G(ZZIP("ERROR"))'="" S RESULTS="ZIP CODE NOT FOUND" Q
  1.  I STATE'=ZZIP("STATE") S RESULTS="STATE MISMATCH ON ZIP" Q
  1.  S RESULTS="VALID ZIP/STATE"
  1.  Q
  1. AMEND(RESULTS,OLDIEN) ; File new Amended Case
  1.  ;  Input:  OLDIEN - The ASISTS IEN for the case to have an
  1.  ;                   amendment created for.
  1.  ; Output: RESULTS - Single value with the new case number
  1.  ;
  1.  N DLAYGO
  1.  Q:$P(^OOPS(2260,OLDIEN,0),"^",6)'=0   ;defensive code, should not occur
  1.  S NUM=$P(^OOPS(2260,OLDIEN,0),U,1),SUF=$E(NUM,11)
  1.  S $P(^OOPS(2260,OLDIEN,0),U,6)=3
  1.  S NUM=$E(NUM,1,10)_$S(SUF="":"A",1:$CHAR($ASCII(SUF)+1))
  1.  K DD,DO
  1.  S DLAYGO=2260,DIC="^OOPS(2260,",DIC(0)="QLZ",X=NUM
  1.  D FILE^DICN G:Y=-1 DONE
  1.  S NEWIEN=+Y
  1.  MERGE ^OOPS(2260,NEWIEN)=^OOPS(2260,OLDIEN)
  1.  S OOP=^OOPS(2260,NEWIEN,0)
  1.  S $P(OOP,U,1)=NUM,$P(OOP,U,6)=0,$P(OOP,U,11)="",$P(OOP,U,19)=""
  1.  S ^OOPS(2260,NEWIEN,0)=OOP,$P(^OOPS(2260,NEWIEN,"CA"),U,6)=""
  1.  S DIK="^OOPS(2260,",DA=NEWIEN D IX^DIK
  1.  K ^OOPS(2260,NEWIEN,"2162ES")
  1.  K ^OOPS(2260,NEWIEN,"CA1ES")
  1.  K ^OOPS(2260,NEWIEN,"CA2ES")
  1.  N IEN,X,WCPDUZ,WOK
  1.  S WCPDUZ=$P($G(^OOPS(2260,NEWIEN,"WCES")),U)
  1.  I $G(WCPDUZ) S WOK=1,X=WCPDUZ,IEN=OLDIEN D WK^OOPSUTL1
  1.  K ^OOPS(2260,NEWIEN,"WCES")
  1.  S RESULTS=NUM
  1. DONE K DA,DIC,OLDIEN,NEWIEN,NUM,SUF,X,Y,DIK,OOP
  1.  Q
  1. SETDLOC(RESULTS,P1,DATA) ; files the detail location records
  1.  ;  Input - P1 is the Location record IEN concatenated with the station
  1.  ;              subrecord IEN. EX.  38^600  
  1.  ;          DATA is a # subscripted array containing the detail loc data
  1.  ;          in the format - detail location description^Detail Loc IEN  
  1.  ; Output - RESULTS indicating the success of the filing.
  1.  N CNT,IENS,FILE,LV1,LV2,LOC,MSG,REC,RECNO,STAFDA,STR
  1.  S BAD=0,FILE=2261.4,LOC=$P(P1,U),STA=$P(P1,U,2),RESULTS=""
  1.  I $D(DATA)<10 S RESULTS="NO DATA TO FILE, CANNOT CONTINUE" Q
  1.  I '$G(STA) S RESULTS="NO STATION SENT, COULDN'T FILE" Q
  1.  I '$G(LOC) S RESULTS="NO LOCATION SENT, COULDN'T FILE" Q
  1.  I '$D(^OOPS(FILE,LOC,1,"B",STA)) D  I BAD Q
  1.  .S IENS="+1,"_LOC_",",STAFDA(2261.43,IENS,.01)=STA
  1.  .D UPDATE^DIE("","STAFDA","IENS","MSG")
  1.  .I $D(MSG("DIERR")) D
  1.  ..S RESULTS="PROBLEM FILING NEW STATION SUBRECORD",BAD=1
  1.  ;KILL THE DETAIL LOCATION REC FOR STATION AND LOCATION PASSED IN
  1.  S DIENS=$O(^OOPS(FILE,"E",STA,LOC,"")),LV1=$O(^OOPS(FILE,LOC,0))
  1.  I $G(DIENS) D
  1.  .S LV2=$O(^OOPS(FILE,LOC,LV1,DIENS,0))
  1.  .I $G(LV2) K ^OOPS(FILE,LOC,LV1,DIENS,LV2)
  1.  .I $D(^OOPS(FILE,"F",DIENS,LOC)) K ^OOPS(FILE,"F",DIENS,LOC)
  1.  ;RE-FILE THE DETAIL LOCATION LEVEL RECORD
  1.  K STAFDA S CNT=0,RECNO=0,REC=""
  1.  F  S REC=$O(DATA(REC)) Q:REC=""  D
  1.  .S STR=DATA(REC),RECNO=$P(STR,U,2),CNT=CNT+1
  1.  .I RECNO="" S RECNO=CNT
  1.  .S IENS="+"_RECNO_","_DIENS_","_LOC_","
  1.  .S STAFDA(2261.431,IENS,.01)=$P(STR,U,1)
  1.  D UPDATE^DIE("E","STAFDA","IENS","MSG")
  1.  I '$D(MSG) S RESULTS="Filing Successful"
  1.  K MSG,STR,Y,X,%DT
  1.  Q