- 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 Feb 19, 2025@00:18:15 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