source: FOIAVistA/tag/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFBK1.m@ 636

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