Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFBK1

IBDFBK1.m

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