IBDFBK1 ;ALB/AAS - AICS broker Utilities ;23-May-95
;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
;
GETFS(RESULT,IBDF) ;
; -- broker call back to return the formspec in IBDFS for form FORMID
;
N FORMID,START,STOP,GLB,IBD
;
S FORMID=$G(IBDF("FORMID"))
S START=$G(IBDF("START"),0) ; Default is zero
S STOP=$G(IBDF("STOP"),50) ; Default is 50
;S GLB=$G(IBDF("GLB")) ; Pass in global later.
;
I $G(FORMID)="" S RESULT(1)="$$FORMID INVALID$$" G GETFSQ
I +FORMID'=FORMID S FORMID=$E($P(FORMID,"."),3,8)
I +FORMID<1 S RESULT(1)="$$FORMID INVALID$$" G GETFSQ
;
K RESULT
I '$D(^IBD(359.2,FORMID,10)) D SCAN^IBDFBKS(FORMID)
I '$D(^IBD(359.2,FORMID,10)) S RESULT(1)="$$FORMID INVALID$$" G GETFSQ
;
F IBD=START:1:STOP S RESULT(IBD)=$G(^IBD(359.2,FORMID,10,IBD,0)) I RESULT(IBD)="",$O(^IBD(359.2,FORMID,10,IBD))="" S RESULT(IBD)="$$END$$" Q
;
GETFSQ Q
;
IMAGEID(RESULT,TEST) ;
; -- broker call back to return the next image id to save unknonw forms
S RESULT=0
L +^IBD(357.97,.03):2
S RESULT=$P(^IBD(357.97,1,0),"^",3)+1
S:RESULT<1 RESULT=1 S:RESULT>999999 RESULT=1
S $P(^IBD(357.97,1,0),"^",3)=RESULT
L -^IBD(357.97,.03)
Q
;
ETIME(RESULT,IBDF) ; -- broker call back
; -- store elapsed time and user inputting data
; -- called by manual data entry (ibdfde1)
;
N NODE
S RESULT=0
I '$G(IBDF("FORM")) G ETQ
S NODE=$G(^IBD(357.96,+IBDF("FORM"),0)) I NODE="" G ETQ
S FDAROOT(357.96,+IBDF("FORM")_",",.15)=$G(IBDF("SECONDS"))+$P(NODE,"^",15)
I $P(NODE,"^",16)="" S FDAROOT(357.96,+IBDF("FORM")_",",.16)=$G(IBDF("USER"))
D FILE^DIE("","FDAROOT","IBDFERR")
S RESULT=1
K PXCA
ETQ Q
;
WSERR(RESULT,FORMID) ; -- broker call back
; -- store error occuring on workstation
; occures when user cancels recognition.
;
S FORMID=+$G(FORMID("FORMID")),FORMID("SOURCE")=1
D LOGERR^IBDF18E2(FORMID("ERRNO"),.FORMID)
S RESULT=1
WSERRQ Q
;
IMAGENM(RESULT,IBDF) ; -- broker call back
; -- store names of images stored and their location
; along with the form id information
;
N X,Y,NAME,PATH,FDA,IENS,FDAIEN,IBDERR
S RESULT=0
I $G(^IBD(357.96,+$G(IBDF("FORMID")),0))=""!($G(IBDF("IMAGE"))="") G IMGNMQ
;
F I=1:1 S X=$P(IBDF("IMAGE"),"\",I) Q:X="" S NAME=$P(IBDF("IMAGE"),"\",I),PATH=$P(IBDF("IMAGE"),"\",1,I-1)
S IENS="+1,"_IBDF("FORMID")_","
S FDA(357.963,IENS,.01)=NAME
S FDA(357.963,IENS,.02)=PATH
S FDA(357.963,IENS,.03)=$G(IBDF("PAGE"))
S FDA(357.963,IENS,.04)=$G(IBDF("WSID"))
S FDA(357.963,IENS,.05)=$G(DUZ)
S FDA(357.963,IENS,.06)=$$NOW^XLFDT
;
; -- flag is as received if page already received
S SCANPG=+$O(^IBD(357.96,IBDF("FORMID"),9,"B",IBDF("PAGE"),0))
I $P($G(^IBD(357.96,+$G(IBDF("FORMID")),9,SCANPG,0)),"^",2) S FDA(357.963,IENS,.07)=1
;
D UPDATE^DIE("","FDA","FDAIEN","IBDERR")
I '$D(IBDERR) S RESULT=1
IMGNMQ Q
;
FORMID(RESULT,FORMNO) ;
; -- broker call back to turn a formId into patient name/ssn/clinic/appt/formtype/status
;
N IBID
S RESULT="^^^^"
S IBID=+$P($G(FORMNO)," ",3)
Q:'$G(IBID)
S RESULT=$$FINDPT^IBDF18C(IBID)
Q
;
VALIDAV(IBDUSER,IBDFKEY) ;
; -- broker call back to validate security key, make sure duz array set
; for xwb1t17
; -- Output User Info
; Piece 1 = DUZ Piece 4 = Site
; Piece 2 = DUZ(0) Piece 5 = UCI/VOL
; Piece 3 = UserName Piece 6 = Security key if held
;
; -- Invalid User codes
; piece 1 = 0 =: Null or "^" in codes
; piece 1 = -1 =: Invalid access code pair
; piece 1 = -2 =: Invalid user (terminated, etc.)
;
I '$D(DT) D DT^DICRW
N X,Y,KEY,XUM,XUSER,XQUR,XUF,XUENV,NODE
S NODE=$G(^VA(200,+$G(DUZ),0))
D UCI^%ZOSV S UCI=Y
S KEY=""
I $G(IBDFKEY)'="" I $D(^XUSEC(IBDFKEY,+DUZ)) S KEY=IBDFKEY
S IBDUSER=DUZ_"^"_$P(NODE,"^",4)_"^"_$P(NODE,"^")_"^"_$P($$SITE^VASITE,"^",2)_"^"_UCI_"^"_KEY
Q
;
SECM(RESULT,IBDUZ) ;
; -- broker call back to return array of secondary menus in array RESULT
;
I +$G(IBDUZ)<1 S RESULT(1)="No user Identified" G SECMQ
;
N COUNT,MENU,IEN
S COUNT=0,MENU=0
F S MENU=$O(^VA(200,+IBDUZ,203,MENU)) Q:'MENU D
. S IEN=+$G(^VA(200,+IBDUZ,203,MENU,0))
. S COUNT=COUNT+1,RESULT(COUNT)=$$GET1^DIQ(19,+IEN,.01) I RESULT(COUNT)']"" S RESULT(COUNT)="Unknown"
;
I COUNT<1 S RESULT(1)="No Secondary Menus"
;
SECMQ Q
;
TESTI ; -- test storing image name
S IBDF("IMAGE")="c:\vista\aics\a8001.tif"
S IBDF("WSID")="A"
S IBDF("PAGE")=1
S IBDF("FORMID")=800
D IMAGENM(.RESULT,.IBDF)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFBK1 4515 printed Sep 23, 2025@20:27:53 Page 2
IBDFBK1 ;ALB/AAS - AICS broker Utilities ;23-May-95
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
+2 ;
GETFS(RESULT,IBDF) ;
+1 ; -- broker call back to return the formspec in IBDFS for form FORMID
+2 ;
+3 NEW FORMID,START,STOP,GLB,IBD
+4 ;
+5 SET FORMID=$GET(IBDF("FORMID"))
+6 ; Default is zero
SET START=$GET(IBDF("START"),0)
+7 ; Default is 50
SET STOP=$GET(IBDF("STOP"),50)
+8 ;S GLB=$G(IBDF("GLB")) ; Pass in global later.
+9 ;
+10 IF $GET(FORMID)=""
SET RESULT(1)="$$FORMID INVALID$$"
GOTO GETFSQ
+11 IF +FORMID'=FORMID
SET FORMID=$EXTRACT($PIECE(FORMID,"."),3,8)
+12 IF +FORMID<1
SET RESULT(1)="$$FORMID INVALID$$"
GOTO GETFSQ
+13 ;
+14 KILL RESULT
+15 IF '$DATA(^IBD(359.2,FORMID,10))
DO SCAN^IBDFBKS(FORMID)
+16 IF '$DATA(^IBD(359.2,FORMID,10))
SET RESULT(1)="$$FORMID INVALID$$"
GOTO GETFSQ
+17 ;
+18 FOR IBD=START:1:STOP
SET RESULT(IBD)=$GET(^IBD(359.2,FORMID,10,IBD,0))
IF RESULT(IBD)=""
IF $ORDER(^IBD(359.2,FORMID,10,IBD))=""
SET RESULT(IBD)="$$END$$"
QUIT
+19 ;
GETFSQ QUIT
+1 ;
IMAGEID(RESULT,TEST) ;
+1 ; -- broker call back to return the next image id to save unknonw forms
+2 SET RESULT=0
+3 LOCK +^IBD(357.97,.03):2
+4 SET RESULT=$PIECE(^IBD(357.97,1,0),"^",3)+1
+5 if RESULT<1
SET RESULT=1
if RESULT>999999
SET RESULT=1
+6 SET $PIECE(^IBD(357.97,1,0),"^",3)=RESULT
+7 LOCK -^IBD(357.97,.03)
+8 QUIT
+9 ;
ETIME(RESULT,IBDF) ; -- broker call back
+1 ; -- store elapsed time and user inputting data
+2 ; -- called by manual data entry (ibdfde1)
+3 ;
+4 NEW NODE
+5 SET RESULT=0
+6 IF '$GET(IBDF("FORM"))
GOTO ETQ
+7 SET NODE=$GET(^IBD(357.96,+IBDF("FORM"),0))
IF NODE=""
GOTO ETQ
+8 SET FDAROOT(357.96,+IBDF("FORM")_",",.15)=$GET(IBDF("SECONDS"))+$PIECE(NODE,"^",15)
+9 IF $PIECE(NODE,"^",16)=""
SET FDAROOT(357.96,+IBDF("FORM")_",",.16)=$GET(IBDF("USER"))
+10 DO FILE^DIE("","FDAROOT","IBDFERR")
+11 SET RESULT=1
+12 KILL PXCA
ETQ QUIT
+1 ;
WSERR(RESULT,FORMID) ; -- broker call back
+1 ; -- store error occuring on workstation
+2 ; occures when user cancels recognition.
+3 ;
+4 SET FORMID=+$GET(FORMID("FORMID"))
SET FORMID("SOURCE")=1
+5 DO LOGERR^IBDF18E2(FORMID("ERRNO"),.FORMID)
+6 SET RESULT=1
WSERRQ QUIT
+1 ;
IMAGENM(RESULT,IBDF) ; -- broker call back
+1 ; -- store names of images stored and their location
+2 ; along with the form id information
+3 ;
+4 NEW X,Y,NAME,PATH,FDA,IENS,FDAIEN,IBDERR
+5 SET RESULT=0
+6 IF $GET(^IBD(357.96,+$GET(IBDF("FORMID")),0))=""!($GET(IBDF("IMAGE"))="")
GOTO IMGNMQ
+7 ;
+8 FOR I=1:1
SET X=$PIECE(IBDF("IMAGE"),"\",I)
if X=""
QUIT
SET NAME=$PIECE(IBDF("IMAGE"),"\",I)
SET PATH=$PIECE(IBDF("IMAGE"),"\",1,I-1)
+9 SET IENS="+1,"_IBDF("FORMID")_","
+10 SET FDA(357.963,IENS,.01)=NAME
+11 SET FDA(357.963,IENS,.02)=PATH
+12 SET FDA(357.963,IENS,.03)=$GET(IBDF("PAGE"))
+13 SET FDA(357.963,IENS,.04)=$GET(IBDF("WSID"))
+14 SET FDA(357.963,IENS,.05)=$GET(DUZ)
+15 SET FDA(357.963,IENS,.06)=$$NOW^XLFDT
+16 ;
+17 ; -- flag is as received if page already received
+18 SET SCANPG=+$ORDER(^IBD(357.96,IBDF("FORMID"),9,"B",IBDF("PAGE"),0))
+19 IF $PIECE($GET(^IBD(357.96,+$GET(IBDF("FORMID")),9,SCANPG,0)),"^",2)
SET FDA(357.963,IENS,.07)=1
+20 ;
+21 DO UPDATE^DIE("","FDA","FDAIEN","IBDERR")
+22 IF '$DATA(IBDERR)
SET RESULT=1
IMGNMQ QUIT
+1 ;
FORMID(RESULT,FORMNO) ;
+1 ; -- broker call back to turn a formId into patient name/ssn/clinic/appt/formtype/status
+2 ;
+3 NEW IBID
+4 SET RESULT="^^^^"
+5 SET IBID=+$PIECE($GET(FORMNO)," ",3)
+6 if '$GET(IBID)
QUIT
+7 SET RESULT=$$FINDPT^IBDF18C(IBID)
+8 QUIT
+9 ;
VALIDAV(IBDUSER,IBDFKEY) ;
+1 ; -- broker call back to validate security key, make sure duz array set
+2 ; for xwb1t17
+3 ; -- Output User Info
+4 ; Piece 1 = DUZ Piece 4 = Site
+5 ; Piece 2 = DUZ(0) Piece 5 = UCI/VOL
+6 ; Piece 3 = UserName Piece 6 = Security key if held
+7 ;
+8 ; -- Invalid User codes
+9 ; piece 1 = 0 =: Null or "^" in codes
+10 ; piece 1 = -1 =: Invalid access code pair
+11 ; piece 1 = -2 =: Invalid user (terminated, etc.)
+12 ;
+13 IF '$DATA(DT)
DO DT^DICRW
+14 NEW X,Y,KEY,XUM,XUSER,XQUR,XUF,XUENV,NODE
+15 SET NODE=$GET(^VA(200,+$GET(DUZ),0))
+16 DO UCI^%ZOSV
SET UCI=Y
+17 SET KEY=""
+18 IF $GET(IBDFKEY)'=""
IF $DATA(^XUSEC(IBDFKEY,+DUZ))
SET KEY=IBDFKEY
+19 SET IBDUSER=DUZ_"^"_$PIECE(NODE,"^",4)_"^"_$PIECE(NODE,"^")_"^"_$PIECE($$SITE^VASITE,"^",2)_"^"_UCI_"^"_KEY
+20 QUIT
+21 ;
SECM(RESULT,IBDUZ) ;
+1 ; -- broker call back to return array of secondary menus in array RESULT
+2 ;
+3 IF +$GET(IBDUZ)<1
SET RESULT(1)="No user Identified"
GOTO SECMQ
+4 ;
+5 NEW COUNT,MENU,IEN
+6 SET COUNT=0
SET MENU=0
+7 FOR
SET MENU=$ORDER(^VA(200,+IBDUZ,203,MENU))
if 'MENU
QUIT
Begin DoDot:1
+8 SET IEN=+$GET(^VA(200,+IBDUZ,203,MENU,0))
+9 SET COUNT=COUNT+1
SET RESULT(COUNT)=$$GET1^DIQ(19,+IEN,.01)
IF RESULT(COUNT)']""
SET RESULT(COUNT)="Unknown"
End DoDot:1
+10 ;
+11 IF COUNT<1
SET RESULT(1)="No Secondary Menus"
+12 ;
SECMQ QUIT
+1 ;
TESTI ; -- test storing image name
+1 SET IBDF("IMAGE")="c:\vista\aics\a8001.tif"
+2 SET IBDF("WSID")="A"
+3 SET IBDF("PAGE")=1
+4 SET IBDF("FORMID")=800
+5 DO IMAGENM(.RESULT,.IBDF)
+6 QUIT
