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 Oct 16, 2024@17:40:03 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
