- OOPSGUIS ;WIOFO/LLH-RPC Broker calls for GUI ;03/25/04
- ;;2.0;ASISTS;**8,11**;Jun 03, 2002
- ;
- STA(RESULTS) ; Get listing of Stations from Edit Site Parameter
- ;
- ; Output: RESULTS contains a listing or all stations listed in the
- ; Edit Site Parameter file. This list will be used for
- ; selecting a station from any field that expects an entry
- ; from the Institution file. If no stations exist, then
- ; a call will automatically be made to GETINST^OOPSGUI7
- ; to use the rpc to get all the stations.
- ;
- N ARR,CN,FAC,IFLAG,SNAME,SNUM,SP,STA,VAL
- K ^TMP("OOPSINST",$J)
- S (CN,SP)=0
- F S SP=$O(^OOPS(2262,SP)) Q:SP="" S STA=0 D
- .F S STA=$O(^OOPS(2262,SP,STA)) Q:STA'>0 S IEN=0 D
- ..F S IEN=$O(^OOPS(2262,SP,STA,IEN)) Q:IEN'>0 D
- ...S FAC=$P($G(^OOPS(2262,SP,STA,IEN,0)),U,1)
- ...I '$G(FAC) Q
- ...; have station #, now go to the institution file and get the info
- ...I $$GET1^DIQ(4,FAC,101)=1 Q ; FAC inactive, don't get
- ...S SNAME=$$GET1^DIQ(4,FAC,.01) I $G(SNAME)="" Q
- ...S SNUM=$$GET1^DIQ(4,FAC,99)
- ...S VAL=SNAME_" = "_SNUM
- ...S CN=CN+1,^TMP("OOPSINST",$J,CN)=FAC_":"_VAL_$C(10)
- S CN=CN+1,^TMP("OOPSINST",$J,CN)="999999:All Stations"
- I CN=1 D GETINST^OOPSGUI7(.ARR) Q ; if only entry = all get all
- S RESULTS=$NA(^TMP("OOPSINST",$J))
- Q
- ;
- SIGNCA7(RESULTS,INPUT,SIGN) ; Validates Electronic Signature and creates
- ; validation code to ensure data not changed
- ; Input: INPUT - FILE^FIELD^IEN where File and Field are the file
- ; and field the data is being filed into and IEN
- ; is the internal record number.
- ; SIGN - the electronic signature to be encrypted
- ; Output: RESULTS - is an array containing a list of fields that did
- ; not pass data validation prior to applying the ES.
- ;
- N CALL,CHKSUM,IEN,ESIG,FILE,FLD,FLD48,FLD84,FLD95,FLD96,FLD97,REC,REC1
- N SIGNBLK,VALID,VER,DR,DA,DIE
- S RESULTS="SIGNED"
- S FILE=$P($G(INPUT),U),FLD=$P($G(INPUT),U,2),IEN=$P($G(INPUT),U,3)
- I '$G(IEN)!('$G(FILE))!('$G(FLD)) S RESULTS(1)="Invalid Parameters" Q
- I $G(SIGN)="" S RESULTS="No signature passed in" Q
- S CALL=$S(FLD=48:"E",FLD=84:"W",1:"")
- I CALL="" S RESULTS="Invalid field number" Q
- ; S VALID=0 D CHKFLD(IEN,CALL.VALID) I 'VALID Q
- S ESIG=$$HASH($$DECRYP^XUSRB1(SIGN))
- I $G(ESIG)=""!(ESIG'=$P($G(^VA(200,DUZ,20)),U,4)="") D Q
- . S RESULTS="Invalid Electronic Signature"
- S SIGNBLK=$P($G(^VA(200,DUZ,20)),U,2)
- I SIGNBLK="" S RESULTS="No signature block on file" Q
- K DR S DIE="^OOPS("_FILE_",",DA=IEN
- D NOW^%DTC S DTIME=%
- I CALL="E" D
- .S REC=$G(^OOPS(FILE,IEN,0)),REC1=$G(^OOPS(FILE,IEN,"CA7S2"))
- .S CHKSUM=$$SUM(IEN_U_REC_U_REC1)
- .S FLD48=$$ENCODE(SIGNBLK,DUZ,CHKSUM),FLD96=1
- .S FLD95=$$SUM(SIGNBLK)
- .S DR="47////^S X=+DUZ;48////^S X=FLD48;49////^S X=DTIME"
- .S DR=DR_";95////^S X=FLD95;96////^S X=FLD96"
- I CALL="W" D
- .S REC=$G(^OOPS(FILE,IEN,"CA7S10")),REC1=$G(^OOPS(FILE,IEN,"CA7S13"))
- .S CHKSUM=$$SUM(IEN_U_REC_U_REC1)
- .S FLD84=$$ENCODE(SIGNBLK,DUZ,CHKSUM)
- .S FLD97=$$SUM(SIGNBLK)
- .S DR="83////^S X=+DUZ;84////^S X=FLD84;85////^S X=DTIME"
- .S DR=DR_";97////^S X=FLD97"
- D ^DIE
- I $G(Y)'="" S RESULTS="Problem filing E-Signature" Q
- ; patch 11 - send bulletin when employee signs CA7
- I CALL="E" D
- .N GRP,X0,STR
- .S X0=$P($G(^OOPS(2264,IEN,0)),U,5)
- .S STR=$G(^OOPS(2260,X0,0)) K XMY
- .S XMB(1)=$$GET1^DIQ(2260,X0,4)
- .S XMB(2)=$P(STR,U,1)
- .S XMB="OOPS EMPSIGNCA7"
- .S GRP="OOPS WCP"
- .D MFAC^OOPSMBUL
- .D ^XMB K XMB,XMY,XMM,XMDT
- Q
- HASH(X) ;
- D HASH^XUSHSHP
- Q X
- ENCODE(X,X1,X2) ; X=SIGN BLK, X1=DUZ, X2=CHKSUM CRITICAL FIELDS
- D EN^XUSHSHP
- Q X
- DECODE(RESULTS,IEN,CALL,FORM) ;
- ; Call to return electronic signature to readable form
- ; Input: IEN - internal record number of CA7 case
- ; CALL - call menu - either E (Employee) or W (Workers Comp)
- ; FORM - form - right now only expects CA7
- ; Output: RESULTS - readable electronic signature
- ;
- N FILE,NODE,REC,REC1,VAL,VALID,VER,X,X1,X2
- S RESULTS="",VALID=1
- I '$G(IEN)!($G(CALL)="")!($G(FORM)="") Q
- S (NODE,FILE,VER)=""
- I FORM="CA7" S FILE=2264
- S NODE=$S(CALL="E":"CA7S7",CALL="W":"CA7S15",1:"")
- I FILE=""!(NODE="") Q
- S VER=$P($G(^OOPS(FILE,IEN,"CA7S7")),U,5) I VER'=1 Q
- I CALL="E" D
- .S VAL=$P($G(^OOPS(FILE,IEN,"CA7S7")),U,4) I VAL="" S VALID=0
- .S REC=$G(^OOPS(FILE,IEN,0)),REC1=$G(^OOPS(FILE,IEN,"CA7S2"))
- I CALL="W" D
- .S VAL=$P($G(^OOPS(FILE,IEN,"CA7S15")),U,11) I VAL="" S VALID=0
- .S REC=$G(^OOPS(FILE,IEN,"CA7S10")),REC1=$G(^OOPS(FILE,IEN,"CA7S13"))
- ;
- I 'VALID Q
- S X=$P($G(^OOPS(FILE,IEN,NODE)),U,2) I X="" Q ; ES VALIDATION #
- S X1=$P($G(^OOPS(FILE,IEN,NODE)),U,1) ; USER NUMBER
- S X2=$$SUM(IEN_U_REC_U_REC1) ; CHECKSUM
- D DE^XUSHSHP
- ; I $$SUM(X)'=VAL S X="DECODING FAILED"
- S RESULTS=X
- Q
- ;
- SUM(X) ;CALCULATE CHECKSUM VALUE FOR STRING
- N I,Y
- S Y=0 F I=1:1:$L(X) S Y=$A(X,I)*I+Y
- Q Y
- CLRES(IEN,CALL,FORM) ; Clear signature from CA7, if necessary
- ; Input: IEN - record IEN for CA7
- ; CALL - calling menu - either E (EMP) or W (Workers comp)
- ; FORM - form where ES should be removed (now only CA7)
- N FILE,SIG,NODE,FIELD
- S (FILE,SIG,NODE,FIELD)="",RESULTS="FAILED"
- I ('$G(IEN)),($G(CALL)=""),($G(FORM)="") Q
- I FORM="CA7" S FILE=2264
- I FILE=2264 D
- .I CALL="E" S SIG="CA7S7;1,5"
- .I CALL="W" S SIG="CA7S15;1,3"
- S NODE=$P(SIG,";") Q:NODE=""
- S FIELD=$P(SIG,";",2)
- I '$D(^OOPS(FILE,IEN,NODE)) Q
- F I=$P(FIELD,","):1:$P(FIELD,",",2) S $P(^OOPS(FILE,IEN,NODE),U,I)=""
- Q
- GETDLOC(RESULTS,INPUT) ; Get Detail Loc for specific incident setting
- ; Input: INPUT - File _"^"_Station IEN from a station in the
- ; site par file_"^"_rec ien from file to retrieve
- ; subfile information for.
- ; Output: RESULTS - listing of valid sub file data
- ;
- N CN,FIEN,FILE,I,REC,STA
- S CN=0
- S FILE=$P($G(INPUT),U,1),STA=$P($G(INPUT),U,2),FIEN=$P($G(INPUT),U,3)
- I FILE=""!(STA="")!(FIEN="") D Q
- . S ^TMP($J,"DLOC",CN)="MISSING PARAMETERS",RESULTS=$NA(^TMP($J,"DLOC"))
- S REC=$O(^OOPS(FILE,FIEN,1,"B",STA,""))
- I '$G(REC) S ^TMP($J,"DLOC",CN)="NO DETAIL LOCATIONS LOADED",RESULTS=$NA(^TMP($J,"DLOC")) Q
- I '$D(^OOPS(FILE,"F",REC,FIEN)) D Q
- .S ^TMP($J,"DLOC",CN)="NO DETAIL LOCATIONS LOADED",RESULTS=$NA(^TMP($J,"DLOC"))
- S DATA=""
- F S DATA=$O(^OOPS(FILE,"F",REC,FIEN,DATA)) Q:DATA="" S DATAIEN=0 D
- .S DATAIEN=$O(^OOPS(FILE,"F",REC,FIEN,DATA,DATAIEN))
- .S ^TMP($J,"DLOC",CN)=DATA_U_DATAIEN,CN=CN+1
- S RESULTS=$NA(^TMP($J,"DLOC"))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOOPSGUIS 6684 printed Feb 18, 2025@23:05:35 Page 2
- OOPSGUIS ;WIOFO/LLH-RPC Broker calls for GUI ;03/25/04
- +1 ;;2.0;ASISTS;**8,11**;Jun 03, 2002
- +2 ;
- STA(RESULTS) ; Get listing of Stations from Edit Site Parameter
- +1 ;
- +2 ; Output: RESULTS contains a listing or all stations listed in the
- +3 ; Edit Site Parameter file. This list will be used for
- +4 ; selecting a station from any field that expects an entry
- +5 ; from the Institution file. If no stations exist, then
- +6 ; a call will automatically be made to GETINST^OOPSGUI7
- +7 ; to use the rpc to get all the stations.
- +8 ;
- +9 NEW ARR,CN,FAC,IFLAG,SNAME,SNUM,SP,STA,VAL
- +10 KILL ^TMP("OOPSINST",$JOB)
- +11 SET (CN,SP)=0
- +12 FOR
- SET SP=$ORDER(^OOPS(2262,SP))
- if SP=""
- QUIT
- SET STA=0
- Begin DoDot:1
- +13 FOR
- SET STA=$ORDER(^OOPS(2262,SP,STA))
- if STA'>0
- QUIT
- SET IEN=0
- Begin DoDot:2
- +14 FOR
- SET IEN=$ORDER(^OOPS(2262,SP,STA,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:3
- +15 SET FAC=$PIECE($GET(^OOPS(2262,SP,STA,IEN,0)),U,1)
- +16 IF '$GET(FAC)
- QUIT
- +17 ; have station #, now go to the institution file and get the info
- +18 ; FAC inactive, don't get
- IF $$GET1^DIQ(4,FAC,101)=1
- QUIT
- +19 SET SNAME=$$GET1^DIQ(4,FAC,.01)
- IF $GET(SNAME)=""
- QUIT
- +20 SET SNUM=$$GET1^DIQ(4,FAC,99)
- +21 SET VAL=SNAME_" = "_SNUM
- +22 SET CN=CN+1
- SET ^TMP("OOPSINST",$JOB,CN)=FAC_":"_VAL_$CHAR(10)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 SET CN=CN+1
- SET ^TMP("OOPSINST",$JOB,CN)="999999:All Stations"
- +24 ; if only entry = all get all
- IF CN=1
- DO GETINST^OOPSGUI7(.ARR)
- QUIT
- +25 SET RESULTS=$NAME(^TMP("OOPSINST",$JOB))
- +26 QUIT
- +27 ;
- SIGNCA7(RESULTS,INPUT,SIGN) ; Validates Electronic Signature and creates
- +1 ; validation code to ensure data not changed
- +2 ; Input: INPUT - FILE^FIELD^IEN where File and Field are the file
- +3 ; and field the data is being filed into and IEN
- +4 ; is the internal record number.
- +5 ; SIGN - the electronic signature to be encrypted
- +6 ; Output: RESULTS - is an array containing a list of fields that did
- +7 ; not pass data validation prior to applying the ES.
- +8 ;
- +9 NEW CALL,CHKSUM,IEN,ESIG,FILE,FLD,FLD48,FLD84,FLD95,FLD96,FLD97,REC,REC1
- +10 NEW SIGNBLK,VALID,VER,DR,DA,DIE
- +11 SET RESULTS="SIGNED"
- +12 SET FILE=$PIECE($GET(INPUT),U)
- SET FLD=$PIECE($GET(INPUT),U,2)
- SET IEN=$PIECE($GET(INPUT),U,3)
- +13 IF '$GET(IEN)!('$GET(FILE))!('$GET(FLD))
- SET RESULTS(1)="Invalid Parameters"
- QUIT
- +14 IF $GET(SIGN)=""
- SET RESULTS="No signature passed in"
- QUIT
- +15 SET CALL=$SELECT(FLD=48:"E",FLD=84:"W",1:"")
- +16 IF CALL=""
- SET RESULTS="Invalid field number"
- QUIT
- +17 ; S VALID=0 D CHKFLD(IEN,CALL.VALID) I 'VALID Q
- +18 SET ESIG=$$HASH($$DECRYP^XUSRB1(SIGN))
- +19 IF $GET(ESIG)=""!(ESIG'=$PIECE($GET(^VA(200,DUZ,20)),U,4)="")
- Begin DoDot:1
- +20 SET RESULTS="Invalid Electronic Signature"
- End DoDot:1
- QUIT
- +21 SET SIGNBLK=$PIECE($GET(^VA(200,DUZ,20)),U,2)
- +22 IF SIGNBLK=""
- SET RESULTS="No signature block on file"
- QUIT
- +23 KILL DR
- SET DIE="^OOPS("_FILE_","
- SET DA=IEN
- +24 DO NOW^%DTC
- SET DTIME=%
- +25 IF CALL="E"
- Begin DoDot:1
- +26 SET REC=$GET(^OOPS(FILE,IEN,0))
- SET REC1=$GET(^OOPS(FILE,IEN,"CA7S2"))
- +27 SET CHKSUM=$$SUM(IEN_U_REC_U_REC1)
- +28 SET FLD48=$$ENCODE(SIGNBLK,DUZ,CHKSUM)
- SET FLD96=1
- +29 SET FLD95=$$SUM(SIGNBLK)
- +30 SET DR="47////^S X=+DUZ;48////^S X=FLD48;49////^S X=DTIME"
- +31 SET DR=DR_";95////^S X=FLD95;96////^S X=FLD96"
- End DoDot:1
- +32 IF CALL="W"
- Begin DoDot:1
- +33 SET REC=$GET(^OOPS(FILE,IEN,"CA7S10"))
- SET REC1=$GET(^OOPS(FILE,IEN,"CA7S13"))
- +34 SET CHKSUM=$$SUM(IEN_U_REC_U_REC1)
- +35 SET FLD84=$$ENCODE(SIGNBLK,DUZ,CHKSUM)
- +36 SET FLD97=$$SUM(SIGNBLK)
- +37 SET DR="83////^S X=+DUZ;84////^S X=FLD84;85////^S X=DTIME"
- +38 SET DR=DR_";97////^S X=FLD97"
- End DoDot:1
- +39 DO ^DIE
- +40 IF $GET(Y)'=""
- SET RESULTS="Problem filing E-Signature"
- QUIT
- +41 ; patch 11 - send bulletin when employee signs CA7
- +42 IF CALL="E"
- Begin DoDot:1
- +43 NEW GRP,X0,STR
- +44 SET X0=$PIECE($GET(^OOPS(2264,IEN,0)),U,5)
- +45 SET STR=$GET(^OOPS(2260,X0,0))
- KILL XMY
- +46 SET XMB(1)=$$GET1^DIQ(2260,X0,4)
- +47 SET XMB(2)=$PIECE(STR,U,1)
- +48 SET XMB="OOPS EMPSIGNCA7"
- +49 SET GRP="OOPS WCP"
- +50 DO MFAC^OOPSMBUL
- +51 DO ^XMB
- KILL XMB,XMY,XMM,XMDT
- End DoDot:1
- +52 QUIT
- HASH(X) ;
- +1 DO HASH^XUSHSHP
- +2 QUIT X
- ENCODE(X,X1,X2) ; X=SIGN BLK, X1=DUZ, X2=CHKSUM CRITICAL FIELDS
- +1 DO EN^XUSHSHP
- +2 QUIT X
- DECODE(RESULTS,IEN,CALL,FORM) ;
- +1 ; Call to return electronic signature to readable form
- +2 ; Input: IEN - internal record number of CA7 case
- +3 ; CALL - call menu - either E (Employee) or W (Workers Comp)
- +4 ; FORM - form - right now only expects CA7
- +5 ; Output: RESULTS - readable electronic signature
- +6 ;
- +7 NEW FILE,NODE,REC,REC1,VAL,VALID,VER,X,X1,X2
- +8 SET RESULTS=""
- SET VALID=1
- +9 IF '$GET(IEN)!($GET(CALL)="")!($GET(FORM)="")
- QUIT
- +10 SET (NODE,FILE,VER)=""
- +11 IF FORM="CA7"
- SET FILE=2264
- +12 SET NODE=$SELECT(CALL="E":"CA7S7",CALL="W":"CA7S15",1:"")
- +13 IF FILE=""!(NODE="")
- QUIT
- +14 SET VER=$PIECE($GET(^OOPS(FILE,IEN,"CA7S7")),U,5)
- IF VER'=1
- QUIT
- +15 IF CALL="E"
- Begin DoDot:1
- +16 SET VAL=$PIECE($GET(^OOPS(FILE,IEN,"CA7S7")),U,4)
- IF VAL=""
- SET VALID=0
- +17 SET REC=$GET(^OOPS(FILE,IEN,0))
- SET REC1=$GET(^OOPS(FILE,IEN,"CA7S2"))
- End DoDot:1
- +18 IF CALL="W"
- Begin DoDot:1
- +19 SET VAL=$PIECE($GET(^OOPS(FILE,IEN,"CA7S15")),U,11)
- IF VAL=""
- SET VALID=0
- +20 SET REC=$GET(^OOPS(FILE,IEN,"CA7S10"))
- SET REC1=$GET(^OOPS(FILE,IEN,"CA7S13"))
- End DoDot:1
- +21 ;
- +22 IF 'VALID
- QUIT
- +23 ; ES VALIDATION #
- SET X=$PIECE($GET(^OOPS(FILE,IEN,NODE)),U,2)
- IF X=""
- QUIT
- +24 ; USER NUMBER
- SET X1=$PIECE($GET(^OOPS(FILE,IEN,NODE)),U,1)
- +25 ; CHECKSUM
- SET X2=$$SUM(IEN_U_REC_U_REC1)
- +26 DO DE^XUSHSHP
- +27 ; I $$SUM(X)'=VAL S X="DECODING FAILED"
- +28 SET RESULTS=X
- +29 QUIT
- +30 ;
- SUM(X) ;CALCULATE CHECKSUM VALUE FOR STRING
- +1 NEW I,Y
- +2 SET Y=0
- FOR I=1:1:$LENGTH(X)
- SET Y=$ASCII(X,I)*I+Y
- +3 QUIT Y
- CLRES(IEN,CALL,FORM) ; Clear signature from CA7, if necessary
- +1 ; Input: IEN - record IEN for CA7
- +2 ; CALL - calling menu - either E (EMP) or W (Workers comp)
- +3 ; FORM - form where ES should be removed (now only CA7)
- +4 NEW FILE,SIG,NODE,FIELD
- +5 SET (FILE,SIG,NODE,FIELD)=""
- SET RESULTS="FAILED"
- +6 IF ('$GET(IEN))
- IF ($GET(CALL)="")
- IF ($GET(FORM)="")
- QUIT
- +7 IF FORM="CA7"
- SET FILE=2264
- +8 IF FILE=2264
- Begin DoDot:1
- +9 IF CALL="E"
- SET SIG="CA7S7;1,5"
- +10 IF CALL="W"
- SET SIG="CA7S15;1,3"
- End DoDot:1
- +11 SET NODE=$PIECE(SIG,";")
- if NODE=""
- QUIT
- +12 SET FIELD=$PIECE(SIG,";",2)
- +13 IF '$DATA(^OOPS(FILE,IEN,NODE))
- QUIT
- +14 FOR I=$PIECE(FIELD,","):1:$PIECE(FIELD,",",2)
- SET $PIECE(^OOPS(FILE,IEN,NODE),U,I)=""
- +15 QUIT
- GETDLOC(RESULTS,INPUT) ; Get Detail Loc for specific incident setting
- +1 ; Input: INPUT - File _"^"_Station IEN from a station in the
- +2 ; site par file_"^"_rec ien from file to retrieve
- +3 ; subfile information for.
- +4 ; Output: RESULTS - listing of valid sub file data
- +5 ;
- +6 NEW CN,FIEN,FILE,I,REC,STA
- +7 SET CN=0
- +8 SET FILE=$PIECE($GET(INPUT),U,1)
- SET STA=$PIECE($GET(INPUT),U,2)
- SET FIEN=$PIECE($GET(INPUT),U,3)
- +9 IF FILE=""!(STA="")!(FIEN="")
- Begin DoDot:1
- +10 SET ^TMP($JOB,"DLOC",CN)="MISSING PARAMETERS"
- SET RESULTS=$NAME(^TMP($JOB,"DLOC"))
- End DoDot:1
- QUIT
- +11 SET REC=$ORDER(^OOPS(FILE,FIEN,1,"B",STA,""))
- +12 IF '$GET(REC)
- SET ^TMP($JOB,"DLOC",CN)="NO DETAIL LOCATIONS LOADED"
- SET RESULTS=$NAME(^TMP($JOB,"DLOC"))
- QUIT
- +13 IF '$DATA(^OOPS(FILE,"F",REC,FIEN))
- Begin DoDot:1
- +14 SET ^TMP($JOB,"DLOC",CN)="NO DETAIL LOCATIONS LOADED"
- SET RESULTS=$NAME(^TMP($JOB,"DLOC"))
- End DoDot:1
- QUIT
- +15 SET DATA=""
- +16 FOR
- SET DATA=$ORDER(^OOPS(FILE,"F",REC,FIEN,DATA))
- if DATA=""
- QUIT
- SET DATAIEN=0
- Begin DoDot:1
- +17 SET DATAIEN=$ORDER(^OOPS(FILE,"F",REC,FIEN,DATA,DATAIEN))
- +18 SET ^TMP($JOB,"DLOC",CN)=DATA_U_DATAIEN
- SET CN=CN+1
- End DoDot:1
- +19 SET RESULTS=$NAME(^TMP($JOB,"DLOC"))
- +20 QUIT