- OOPSGUI6 ;WIOFO/LLH-RPC routines for ASISTS Gui ;9/18/01
- ;;2.0;ASISTS;**4,8,7,25**;Jun 03, 2002;Build 4
- ;
- UNIGET(RESULTS) ; Returns entries in the Union table
- N DATA,CNT,SUP,UIEN,UNI
- S CNT=0,UNI=""
- F S UNI=$O(^OOPS(2263.7,"B",UNI)) Q:UNI="" D
- .S UIEN=0
- .F S UIEN=$O(^OOPS(2263.7,"B",UNI,UIEN)) Q:UIEN="" D
- ..S DATA=$G(^OOPS(2263.7,UIEN,0))
- ..S SUP=$$GET1^DIQ(200,$P($G(DATA),U,3),.01)
- ..S RESULTS(CNT)=DATA_U_SUP_U_UIEN,CNT=CNT+1
- Q
- UNIKILL(RESULTS,INPUT) ;
- ; Input - INPUT contains the IEN for Union to be deleted
- ; Output - RESULTS will contain a message indicating the record
- ; was successfully deleted.
- N DA,DIK
- S RESULTS="No Changes Filed"
- S DIK="^OOPS(2263.7,",DA=INPUT
- D ^DIK
- S RESULTS="Record Successfully Deleted"
- Q
- UNIADD ; Files a new record in ^OOPS(2263.7
- N X,DIC,DLAYGO
- K DO
- S DLAYGO=2263.7,DIC="^OOPS(2263.7,",DIC(0)="L",X=NM
- D FILE^DICN
- I Y=-1 S RESULTS="Failed" Q
- S DA=+Y,RESULTS=X_" union added"
- Q
- UNIEDT(RESULTS,INPUT) ; Edits the input in ^OOPS(2263.7
- ; Input - INPUT contains the IEN of Union to be edited or NULL if a
- ; new union is being added. Also has the Union Name,
- ; Acronym, and Representative in the format:
- ; IEN^UNION NAME^UNION ACRONYM^UNION REP
- ; Output - RESULTS contains a status message regarding the filing of
- ; the data
- N DA,DIE,DR,IEN,NM,ACR,REP
- S RESULTS="No Changes Filed"
- S DIE="^OOPS(2263.7,",IEN=$P($G(INPUT),U),NM=$P($G(INPUT),U,2)
- I $G(NM)="" Q
- I $G(IEN)="" D UNIADD S IEN=DA
- I RESULTS="Failed" Q
- S ACR=$P($G(INPUT),U,3),REP=$P($G(INPUT),U,4)
- S DA=IEN,DR=".01///^S X=NM;1///^S X=ACR;2///^S X=REP"
- D ^DIE
- I $G(Y)="" D Q
- .;if next line executed, then straight edit, not an add
- .I RESULTS="No Changes Filed" S RESULTS="Union Update Successful."
- S RESULTS="Union Update NOT Successful."
- Q
- SITEPGET(RESULTS,FORM) ;
- ; Input - FORM = contains either a blank for 'normal' site parameter
- ; look ups or 'OSHA300' if for the OSHA 300A summary input
- ; Output - RESULTS is an array whose 0 node contains the Site
- ; parameter name, IEN, and District Office in the format:
- ; SITE NAME^DISTRICT OFFICE^SITE IEN
- ; Subsequent nodes starting from 1 contain Station information
- ; in the following format:
- ; STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_
- ; U_CHGBKCODE_U_SUB_U_STA
- N CNT,DOFF,IENS,SIEN,STA,SUB,SNAME,STR,STR2,CBCSUF,OOPSST
- S SIEN=$P($G(^OOPS(2262,0)),U,3)
- N CBC,STANM,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE
- S (CBC,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE)=""
- N NA,TTL,PHN,EXT,IND,NAICS,SIC
- S (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
- I '$G(SIEN) S RESULTS(0)="No Site Parameter File was Found" Q
- L +^OOPS(2262,SIEN):2
- E S RESULTS(0)="This option in use by another user, try again later." Q
- S SNAME=$$GET1^DIQ(2262,SIEN,.01),DOFF=$$GET1^DIQ(2262,SIEN,2,"E")
- S RESULTS(0)=SNAME_U_DOFF_U_SIEN
- S CNT=1,SUB=""
- F S SUB=$O(^OOPS(2262,SIEN,SUB)) Q:SUB="" S STA=0 D
- .F S STA=$O(^OOPS(2262,SIEN,SUB,STA)) Q:STA'>0 D
- ..S STR=$G(^OOPS(2262,SIEN,SUB,STA,0)),IENS=STA_","_SUB_","
- ..S STR2=$G(^OOPS(2262,SIEN,SUB,STA,1))
- ..S STATION=$$GET1^DIQ(2262.03,IENS,".01:99")
- ..S STANM=$$GET1^DIQ(2262.03,IENS,.01)_" = "_STATION
- ..;RRA OOPS*25 - 781436 after STA is sent back as null STA needs to be
- ..;set back to original value for proper "$O"rdering.
- ..; Patch 5 llh - if station inactive blank STA
- ..I $$GET1^DIQ(4,$P(STR,U),101)'="" S OOPSST=STA,STA=""
- ..I $G(FORM)="" D
- ...S PNM=$P(STR,U,2),PADD=$P(STR,U,3),PCTY=$P(STR,U,4),PZIP=$P(STR,U,6)
- ...I $P(STR,U,5)'="" S PST=$$GET1^DIQ(2262.03,IENS,4)
- ...I $P(STR,U,7)'="" S PTITLE=$$GET1^DIQ(2262.03,IENS,6)
- ...S CBC=$P(STR,U,8) I $G(CBC)'="" S CBC=$$GET1^DIQ(2263.6,CBC,.01)
- ...;Patch 5 llh - added CBCSUF sets
- ...S CBCSUF=$P(STR,U,9)
- ...S RESULTS(CNT)=STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_U_CBC_U_SUB_U_STA_U_CBCSUF
- ..I $G(FORM)="OSHA300" D
- ...I $P(STR2,U,1)'="" S NA=$$GET1^DIQ(2262.03,IENS,7)
- ...S TTL=$P(STR2,U,2),PHN=$P(STR2,U,3),EXT=$P(STR2,U,4)
- ...S IND=$P(STR2,U,5),SIC=$$GET1^DIQ(2262.03,IENS,12)
- ...S NAICS=$$GET1^DIQ(2262.03,IENS,13)
- ...S RESULTS(CNT)=STANM_U_NA_U_TTL_U_PHN_U_EXT_U_IND_U_SIC_U_NAICS_U_SUB_U_STA_U_$P(STR,U,1)_U
- ..I $G(FORM)="" S (STANM,PNM,PADD,PCTY,PST,PZIP,PTITLE,CBC,CBCSUF)=""
- ..E S (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
- ..I STA="" S STA=OOPSST
- ..S CNT=CNT+1
- L -^OOPS(2262,SIEN)
- Q
- SITEPADD ; Creates a new Station Subfile in the Site Parameter
- ; File (#2262
- N X,DIC,DLAYGO
- S DLAYGO=2262,DIC="^OOPS(2262,"_SIEN_","_SUBF_",",DIC(0)="L"
- S DA(1)=SIEN,X=STANM
- D FILE^DICN
- I Y=-1 S RESULTS="Failed" Q
- S DA=+Y,RESULTS="Successfully Added"
- Q
- SITEPKIL(RESULTS,INPUT) ; Deletes the Station Subfile whose IEN was passed in
- ; Input - INPUT contains the Site Parameter file IEN, the subfile IEN,
- ; and the Station IEN in the format: SIEN^SUBF^STAIEN
- ; Output - RESULTS contains a message with the filing status
- N DA,DIK,SIEN,SUBF,STAIEN
- S SIEN=$P($G(INPUT),U),SUBF=$P($G(INPUT),U,2),STAIEN=$P($G(INPUT),U,3)
- I $G(SIEN)=""!($G(SUBF)="")!($G(STAIEN)="") D Q
- .S RESULTS="Missing Record Identifiers, Cannot file."
- S DIK="^OOPS(2262,"_SIEN_","_SUBF_","
- S DA=STAIEN,DA(1)=SIEN
- D ^DIK
- I $G(Y)="" S RESULTS="Deletion did not occur." Q
- S RESULTS="Record successfully deleted"
- Q
- SITEPEDT(RESULTS,INPUT,DATA,FORM) ;
- ; Edits the Station Subfile whose data and IEN have been passed in
- ; Input - INPUT contains the IEN of the Site Parameter file, subfile
- ; & Station IEN. If adding new station, the Station IEN
- ; = "". INPUT format: SITE IEN^SUBFILE IEN^STATION IEN
- ; DATA contains the data to be filed
- ; FORM is either "" or "OSHA300" to signify data for filing
- ; Output - RESULTS is a single value with a message regarding the
- ; filing status
- N CBC,DA,DIE,DR,PNM,PADD,PCTY,PST,PZIP,PTITLE,SIEN,SUBF,CBCSUF
- N STANM,STAIEN,NA,TTL,PHN,EXT,IND,SIC,NAICS
- S RESULTS="Filing"
- S SIEN=$P($G(INPUT),U),SUBF=$P($G(INPUT),U,2),STAIEN=$P($G(INPUT),U,3)
- I $G(SIEN)="" S RESULTS="Missing Record Identifiers, Cannot file." Q
- I '$G(SUBF) S SUBF=$O(^OOPS(2262,SIEN,0)) I '$G(SUBF) S SUBF=1
- S STANM=$P($G(DATA),U)
- I $G(STANM)="" S RESULTS="Missing Station, Cannot continue." Q
- I $G(STAIEN)="" D SITEPADD S STAIEN=DA
- I $G(STAIEN)="" S RESULTS="Missing Station, cannot file." Q
- S DIE="^OOPS(2262,"_SIEN_","_SUBF_","
- S DA=STAIEN,DA(1)=SIEN,DR=""
- I $G(FORM)="" D
- .S PNM=$P($G(DATA),U,2),PADD=$P($G(DATA),U,3)
- .S PCTY=$P($G(DATA),U,4),PST=$P($G(DATA),U,5),PZIP=$P($G(DATA),U,6)
- .S PTITLE=$P($G(DATA),U,7),CBC=$P($G(DATA),U,8)
- .; Patch 5 llh - Added CBCSUF sets
- .S CBCSUF=$P($G(DATA),U,9)
- .S DR=".7///^S X=CBC;.8///^S X=CBCSUF;1///^S X=PNM;2///^S X=PADD;3///^S X=PCTY;4///^S X=PST;5///^S X=PZIP;6///^S X=PTITLE"
- I $G(FORM)="OSHA300" D
- .S NA=$P($G(DATA),U,2),TTL=$P($G(DATA),U,3),PHN=$P($G(DATA),U,4)
- .S EXT=$P($G(DATA),U,5),IND=$P($G(DATA),U,6),SIC=$P($G(DATA),U,7)
- .S NAICS=$P($G(DATA),U,8)
- .S DR="7///^S X=NA;8///^S X=TTL;9///^S X=PHN;10///^S X=EXT"
- .S DR=DR_";11///^S X=IND;12///^S X=SIC;13///^S X=NAICS"
- I $G(DR)'="" D ^DIE
- I $G(Y)="" D Q
- .; if line below executed, then no Add, only edit
- .I RESULTS="Filing" S RESULTS="Update Successful"
- S RESULTS="Update was not Successful"
- Q
- PARMEDT(RESULTS,INPUT) ; Files changes to top level file (#2262)
- ; Input: INPUT - This variable contains the IEN, Site Name, and
- ; District Office Name to be filed in the format:
- ; IEN^SITE NAME^DISTRICT OFFICE
- ; Output: RESULTS - Results will contain a filing status message
- N DA,DIE,DR,IEN,SITENM,DISOFF
- S IEN=$P($G(INPUT),U),SITENM=$P($G(INPUT),U,2),DISOFF=$P($G(INPUT),U,3)
- I '$G(IEN) S RESULTS="Cannot File Changes, no Record Number" Q
- S DIE="^OOPS(2262,",DA=IEN
- S DR=".01///^S X=SITENM;2///^S X=DISOFF"
- D ^DIE
- I $G(Y)="" S RESULTS="Update Site data Successful" Q
- S RESULTS="Update Site data was NOT Successful"
- Q
- CHGCASE(RESULTS,INPUT,FLD58) ; File Change Case Status
- ; Input: INPUT - IEN^STAT where IEN = the ASISTS case IEN and
- ; STAT = the new case status
- ; DELETE - Reason for Deletion, field #58, file #2260
- ; Output: RESULTS - Message back to client with new Case Status
- ;
- N CURRENT,DR,DIE,IEN,Y,STATUS
- S IEN=$P(INPUT,U),(STATUS,Y)=$P(INPUT,U,2)
- I '$G(IEN) S RESULTS="Missing Record Identifier, cannot file." Q
- I $$GET1^DIQ(2260,IEN,66)'="",(Y=2) D Q
- .S RESULTS="Case transmitted to DOL, cannot change status to Deleted."
- S CURRENT=$$GET1^DIQ(2260,IEN,51,"I")
- CLOSE ; Close
- S DR=""
- S DR="51////"_Y
- ;If current status goes from closed/deleted to Open, reset field 57
- I (CURRENT=1!(CURRENT=2)),(Y=0) S DR=DR_";57////@"
- I FLD58]"" S DR=DR_";58////"_FLD58
- S DIE="^OOPS(2260,",DA=IEN
- D ^DIE K DIE,DA
- I $D(Y)'=0 Q
- S RESULTS="Case Status has been changed to: "_$$GET1^DIQ(2260,IEN,51)
- ;01/02/04 Patch 4 llh- if case = closed, send bulletin
- I STATUS=1 D CLSCASE^OOPSMBUL(IEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUI6 9214 printed Feb 18, 2025@23:05:27 Page 2
- OOPSGUI6 ;WIOFO/LLH-RPC routines for ASISTS Gui ;9/18/01
- +1 ;;2.0;ASISTS;**4,8,7,25**;Jun 03, 2002;Build 4
- +2 ;
- UNIGET(RESULTS) ; Returns entries in the Union table
- +1 NEW DATA,CNT,SUP,UIEN,UNI
- +2 SET CNT=0
- SET UNI=""
- +3 FOR
- SET UNI=$ORDER(^OOPS(2263.7,"B",UNI))
- if UNI=""
- QUIT
- Begin DoDot:1
- +4 SET UIEN=0
- +5 FOR
- SET UIEN=$ORDER(^OOPS(2263.7,"B",UNI,UIEN))
- if UIEN=""
- QUIT
- Begin DoDot:2
- +6 SET DATA=$GET(^OOPS(2263.7,UIEN,0))
- +7 SET SUP=$$GET1^DIQ(200,$PIECE($GET(DATA),U,3),.01)
- +8 SET RESULTS(CNT)=DATA_U_SUP_U_UIEN
- SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +9 QUIT
- UNIKILL(RESULTS,INPUT) ;
- +1 ; Input - INPUT contains the IEN for Union to be deleted
- +2 ; Output - RESULTS will contain a message indicating the record
- +3 ; was successfully deleted.
- +4 NEW DA,DIK
- +5 SET RESULTS="No Changes Filed"
- +6 SET DIK="^OOPS(2263.7,"
- SET DA=INPUT
- +7 DO ^DIK
- +8 SET RESULTS="Record Successfully Deleted"
- +9 QUIT
- UNIADD ; Files a new record in ^OOPS(2263.7
- +1 NEW X,DIC,DLAYGO
- +2 KILL DO
- +3 SET DLAYGO=2263.7
- SET DIC="^OOPS(2263.7,"
- SET DIC(0)="L"
- SET X=NM
- +4 DO FILE^DICN
- +5 IF Y=-1
- SET RESULTS="Failed"
- QUIT
- +6 SET DA=+Y
- SET RESULTS=X_" union added"
- +7 QUIT
- UNIEDT(RESULTS,INPUT) ; Edits the input in ^OOPS(2263.7
- +1 ; Input - INPUT contains the IEN of Union to be edited or NULL if a
- +2 ; new union is being added. Also has the Union Name,
- +3 ; Acronym, and Representative in the format:
- +4 ; IEN^UNION NAME^UNION ACRONYM^UNION REP
- +5 ; Output - RESULTS contains a status message regarding the filing of
- +6 ; the data
- +7 NEW DA,DIE,DR,IEN,NM,ACR,REP
- +8 SET RESULTS="No Changes Filed"
- +9 SET DIE="^OOPS(2263.7,"
- SET IEN=$PIECE($GET(INPUT),U)
- SET NM=$PIECE($GET(INPUT),U,2)
- +10 IF $GET(NM)=""
- QUIT
- +11 IF $GET(IEN)=""
- DO UNIADD
- SET IEN=DA
- +12 IF RESULTS="Failed"
- QUIT
- +13 SET ACR=$PIECE($GET(INPUT),U,3)
- SET REP=$PIECE($GET(INPUT),U,4)
- +14 SET DA=IEN
- SET DR=".01///^S X=NM;1///^S X=ACR;2///^S X=REP"
- +15 DO ^DIE
- +16 IF $GET(Y)=""
- Begin DoDot:1
- +17 ;if next line executed, then straight edit, not an add
- +18 IF RESULTS="No Changes Filed"
- SET RESULTS="Union Update Successful."
- End DoDot:1
- QUIT
- +19 SET RESULTS="Union Update NOT Successful."
- +20 QUIT
- SITEPGET(RESULTS,FORM) ;
- +1 ; Input - FORM = contains either a blank for 'normal' site parameter
- +2 ; look ups or 'OSHA300' if for the OSHA 300A summary input
- +3 ; Output - RESULTS is an array whose 0 node contains the Site
- +4 ; parameter name, IEN, and District Office in the format:
- +5 ; SITE NAME^DISTRICT OFFICE^SITE IEN
- +6 ; Subsequent nodes starting from 1 contain Station information
- +7 ; in the following format:
- +8 ; STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_
- +9 ; U_CHGBKCODE_U_SUB_U_STA
- +10 NEW CNT,DOFF,IENS,SIEN,STA,SUB,SNAME,STR,STR2,CBCSUF,OOPSST
- +11 SET SIEN=$PIECE($GET(^OOPS(2262,0)),U,3)
- +12 NEW CBC,STANM,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE
- +13 SET (CBC,STATION,PNM,PADD,PCTY,PST,PZIP,PTITLE)=""
- +14 NEW NA,TTL,PHN,EXT,IND,NAICS,SIC
- +15 SET (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
- +16 IF '$GET(SIEN)
- SET RESULTS(0)="No Site Parameter File was Found"
- QUIT
- +17 LOCK +^OOPS(2262,SIEN):2
- +18 IF '$TEST
- SET RESULTS(0)="This option in use by another user, try again later."
- QUIT
- +19 SET SNAME=$$GET1^DIQ(2262,SIEN,.01)
- SET DOFF=$$GET1^DIQ(2262,SIEN,2,"E")
- +20 SET RESULTS(0)=SNAME_U_DOFF_U_SIEN
- +21 SET CNT=1
- SET SUB=""
- +22 FOR
- SET SUB=$ORDER(^OOPS(2262,SIEN,SUB))
- if SUB=""
- QUIT
- SET STA=0
- Begin DoDot:1
- +23 FOR
- SET STA=$ORDER(^OOPS(2262,SIEN,SUB,STA))
- if STA'>0
- QUIT
- Begin DoDot:2
- +24 SET STR=$GET(^OOPS(2262,SIEN,SUB,STA,0))
- SET IENS=STA_","_SUB_","
- +25 SET STR2=$GET(^OOPS(2262,SIEN,SUB,STA,1))
- +26 SET STATION=$$GET1^DIQ(2262.03,IENS,".01:99")
- +27 SET STANM=$$GET1^DIQ(2262.03,IENS,.01)_" = "_STATION
- +28 ;RRA OOPS*25 - 781436 after STA is sent back as null STA needs to be
- +29 ;set back to original value for proper "$O"rdering.
- +30 ; Patch 5 llh - if station inactive blank STA
- +31 IF $$GET1^DIQ(4,$PIECE(STR,U),101)'=""
- SET OOPSST=STA
- SET STA=""
- +32 IF $GET(FORM)=""
- Begin DoDot:3
- +33 SET PNM=$PIECE(STR,U,2)
- SET PADD=$PIECE(STR,U,3)
- SET PCTY=$PIECE(STR,U,4)
- SET PZIP=$PIECE(STR,U,6)
- +34 IF $PIECE(STR,U,5)'=""
- SET PST=$$GET1^DIQ(2262.03,IENS,4)
- +35 IF $PIECE(STR,U,7)'=""
- SET PTITLE=$$GET1^DIQ(2262.03,IENS,6)
- +36 SET CBC=$PIECE(STR,U,8)
- IF $GET(CBC)'=""
- SET CBC=$$GET1^DIQ(2263.6,CBC,.01)
- +37 ;Patch 5 llh - added CBCSUF sets
- +38 SET CBCSUF=$PIECE(STR,U,9)
- +39 SET RESULTS(CNT)=STANM_U_PNM_U_PADD_U_PCTY_U_PST_U_PZIP_U_PTITLE_U_CBC_U_SUB_U_STA_U_CBCSUF
- End DoDot:3
- +40 IF $GET(FORM)="OSHA300"
- Begin DoDot:3
- +41 IF $PIECE(STR2,U,1)'=""
- SET NA=$$GET1^DIQ(2262.03,IENS,7)
- +42 SET TTL=$PIECE(STR2,U,2)
- SET PHN=$PIECE(STR2,U,3)
- SET EXT=$PIECE(STR2,U,4)
- +43 SET IND=$PIECE(STR2,U,5)
- SET SIC=$$GET1^DIQ(2262.03,IENS,12)
- +44 SET NAICS=$$GET1^DIQ(2262.03,IENS,13)
- +45 SET RESULTS(CNT)=STANM_U_NA_U_TTL_U_PHN_U_EXT_U_IND_U_SIC_U_NAICS_U_SUB_U_STA_U_$PIECE(STR,U,1)_U
- End DoDot:3
- +46 IF $GET(FORM)=""
- SET (STANM,PNM,PADD,PCTY,PST,PZIP,PTITLE,CBC,CBCSUF)=""
- +47 IF '$TEST
- SET (NA,TTL,PHN,EXT,IND,NAICS,SIC)=""
- +48 IF STA=""
- SET STA=OOPSST
- +49 SET CNT=CNT+1
- End DoDot:2
- End DoDot:1
- +50 LOCK -^OOPS(2262,SIEN)
- +51 QUIT
- SITEPADD ; Creates a new Station Subfile in the Site Parameter
- +1 ; File (#2262
- +2 NEW X,DIC,DLAYGO
- +3 SET DLAYGO=2262
- SET DIC="^OOPS(2262,"_SIEN_","_SUBF_","
- SET DIC(0)="L"
- +4 SET DA(1)=SIEN
- SET X=STANM
- +5 DO FILE^DICN
- +6 IF Y=-1
- SET RESULTS="Failed"
- QUIT
- +7 SET DA=+Y
- SET RESULTS="Successfully Added"
- +8 QUIT
- SITEPKIL(RESULTS,INPUT) ; Deletes the Station Subfile whose IEN was passed in
- +1 ; Input - INPUT contains the Site Parameter file IEN, the subfile IEN,
- +2 ; and the Station IEN in the format: SIEN^SUBF^STAIEN
- +3 ; Output - RESULTS contains a message with the filing status
- +4 NEW DA,DIK,SIEN,SUBF,STAIEN
- +5 SET SIEN=$PIECE($GET(INPUT),U)
- SET SUBF=$PIECE($GET(INPUT),U,2)
- SET STAIEN=$PIECE($GET(INPUT),U,3)
- +6 IF $GET(SIEN)=""!($GET(SUBF)="")!($GET(STAIEN)="")
- Begin DoDot:1
- +7 SET RESULTS="Missing Record Identifiers, Cannot file."
- End DoDot:1
- QUIT
- +8 SET DIK="^OOPS(2262,"_SIEN_","_SUBF_","
- +9 SET DA=STAIEN
- SET DA(1)=SIEN
- +10 DO ^DIK
- +11 IF $GET(Y)=""
- SET RESULTS="Deletion did not occur."
- QUIT
- +12 SET RESULTS="Record successfully deleted"
- +13 QUIT
- SITEPEDT(RESULTS,INPUT,DATA,FORM) ;
- +1 ; Edits the Station Subfile whose data and IEN have been passed in
- +2 ; Input - INPUT contains the IEN of the Site Parameter file, subfile
- +3 ; & Station IEN. If adding new station, the Station IEN
- +4 ; = "". INPUT format: SITE IEN^SUBFILE IEN^STATION IEN
- +5 ; DATA contains the data to be filed
- +6 ; FORM is either "" or "OSHA300" to signify data for filing
- +7 ; Output - RESULTS is a single value with a message regarding the
- +8 ; filing status
- +9 NEW CBC,DA,DIE,DR,PNM,PADD,PCTY,PST,PZIP,PTITLE,SIEN,SUBF,CBCSUF
- +10 NEW STANM,STAIEN,NA,TTL,PHN,EXT,IND,SIC,NAICS
- +11 SET RESULTS="Filing"
- +12 SET SIEN=$PIECE($GET(INPUT),U)
- SET SUBF=$PIECE($GET(INPUT),U,2)
- SET STAIEN=$PIECE($GET(INPUT),U,3)
- +13 IF $GET(SIEN)=""
- SET RESULTS="Missing Record Identifiers, Cannot file."
- QUIT
- +14 IF '$GET(SUBF)
- SET SUBF=$ORDER(^OOPS(2262,SIEN,0))
- IF '$GET(SUBF)
- SET SUBF=1
- +15 SET STANM=$PIECE($GET(DATA),U)
- +16 IF $GET(STANM)=""
- SET RESULTS="Missing Station, Cannot continue."
- QUIT
- +17 IF $GET(STAIEN)=""
- DO SITEPADD
- SET STAIEN=DA
- +18 IF $GET(STAIEN)=""
- SET RESULTS="Missing Station, cannot file."
- QUIT
- +19 SET DIE="^OOPS(2262,"_SIEN_","_SUBF_","
- +20 SET DA=STAIEN
- SET DA(1)=SIEN
- SET DR=""
- +21 IF $GET(FORM)=""
- Begin DoDot:1
- +22 SET PNM=$PIECE($GET(DATA),U,2)
- SET PADD=$PIECE($GET(DATA),U,3)
- +23 SET PCTY=$PIECE($GET(DATA),U,4)
- SET PST=$PIECE($GET(DATA),U,5)
- SET PZIP=$PIECE($GET(DATA),U,6)
- +24 SET PTITLE=$PIECE($GET(DATA),U,7)
- SET CBC=$PIECE($GET(DATA),U,8)
- +25 ; Patch 5 llh - Added CBCSUF sets
- +26 SET CBCSUF=$PIECE($GET(DATA),U,9)
- +27 SET DR=".7///^S X=CBC;.8///^S X=CBCSUF;1///^S X=PNM;2///^S X=PADD;3///^S X=PCTY;4///^S X=PST;5///^S X=PZIP;6///^S X=PTITLE"
- End DoDot:1
- +28 IF $GET(FORM)="OSHA300"
- Begin DoDot:1
- +29 SET NA=$PIECE($GET(DATA),U,2)
- SET TTL=$PIECE($GET(DATA),U,3)
- SET PHN=$PIECE($GET(DATA),U,4)
- +30 SET EXT=$PIECE($GET(DATA),U,5)
- SET IND=$PIECE($GET(DATA),U,6)
- SET SIC=$PIECE($GET(DATA),U,7)
- +31 SET NAICS=$PIECE($GET(DATA),U,8)
- +32 SET DR="7///^S X=NA;8///^S X=TTL;9///^S X=PHN;10///^S X=EXT"
- +33 SET DR=DR_";11///^S X=IND;12///^S X=SIC;13///^S X=NAICS"
- End DoDot:1
- +34 IF $GET(DR)'=""
- DO ^DIE
- +35 IF $GET(Y)=""
- Begin DoDot:1
- +36 ; if line below executed, then no Add, only edit
- +37 IF RESULTS="Filing"
- SET RESULTS="Update Successful"
- End DoDot:1
- QUIT
- +38 SET RESULTS="Update was not Successful"
- +39 QUIT
- PARMEDT(RESULTS,INPUT) ; Files changes to top level file (#2262)
- +1 ; Input: INPUT - This variable contains the IEN, Site Name, and
- +2 ; District Office Name to be filed in the format:
- +3 ; IEN^SITE NAME^DISTRICT OFFICE
- +4 ; Output: RESULTS - Results will contain a filing status message
- +5 NEW DA,DIE,DR,IEN,SITENM,DISOFF
- +6 SET IEN=$PIECE($GET(INPUT),U)
- SET SITENM=$PIECE($GET(INPUT),U,2)
- SET DISOFF=$PIECE($GET(INPUT),U,3)
- +7 IF '$GET(IEN)
- SET RESULTS="Cannot File Changes, no Record Number"
- QUIT
- +8 SET DIE="^OOPS(2262,"
- SET DA=IEN
- +9 SET DR=".01///^S X=SITENM;2///^S X=DISOFF"
- +10 DO ^DIE
- +11 IF $GET(Y)=""
- SET RESULTS="Update Site data Successful"
- QUIT
- +12 SET RESULTS="Update Site data was NOT Successful"
- +13 QUIT
- CHGCASE(RESULTS,INPUT,FLD58) ; File Change Case Status
- +1 ; Input: INPUT - IEN^STAT where IEN = the ASISTS case IEN and
- +2 ; STAT = the new case status
- +3 ; DELETE - Reason for Deletion, field #58, file #2260
- +4 ; Output: RESULTS - Message back to client with new Case Status
- +5 ;
- +6 NEW CURRENT,DR,DIE,IEN,Y,STATUS
- +7 SET IEN=$PIECE(INPUT,U)
- SET (STATUS,Y)=$PIECE(INPUT,U,2)
- +8 IF '$GET(IEN)
- SET RESULTS="Missing Record Identifier, cannot file."
- QUIT
- +9 IF $$GET1^DIQ(2260,IEN,66)'=""
- IF (Y=2)
- Begin DoDot:1
- +10 SET RESULTS="Case transmitted to DOL, cannot change status to Deleted."
- End DoDot:1
- QUIT
- +11 SET CURRENT=$$GET1^DIQ(2260,IEN,51,"I")
- CLOSE ; Close
- +1 SET DR=""
- +2 SET DR="51////"_Y
- +3 ;If current status goes from closed/deleted to Open, reset field 57
- +4 IF (CURRENT=1!(CURRENT=2))
- IF (Y=0)
- SET DR=DR_";57////@"
- +5 IF FLD58]""
- SET DR=DR_";58////"_FLD58
- +6 SET DIE="^OOPS(2260,"
- SET DA=IEN
- +7 DO ^DIE
- KILL DIE,DA
- +8 IF $DATA(Y)'=0
- QUIT
- +9 SET RESULTS="Case Status has been changed to: "_$$GET1^DIQ(2260,IEN,51)
- +10 ;01/02/04 Patch 4 llh- if case = closed, send bulletin
- +11 IF STATUS=1
- DO CLSCASE^OOPSMBUL(IEN)
- +12 QUIT