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

TIUPNAPI.m

Go to the documentation of this file.
  1. TIUPNAPI ; SLC/JER - API to Replace GMRPAPI ; 8/8/05
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**57,140,175,180,184**;Jun 20, 1997
  1. ;
  1. ; ^DPT( IA #3101
  1. NEW(TIUIFN,DFN,TIUAUTH,TIURDT,TIUTITLE,TIULOC,TIUES,TIUPRT,TIUESBY,TIUASKVS,TIUADEL) ;
  1. ; -- Create new note
  1. ;****************
  1. ; Return variable (must pass by reference):
  1. ; TIUIFN (pass by ref) = New note IFN in file 8925, -1 if error,
  1. ; = IFN^-1 if note filed, w/o signature when
  1. ; TIUES=1 (It has been IFN^-1 as far back
  1. ; as patch 140. Noted on 8/4/05)
  1. ; = -1 if user fails to enter valid cosig
  1. ; = IFN^-1 if TIUESBY>0 & signature fails,
  1. ; if TIUADEL not present
  1. ; = -1^-1 if TIUESBY>0 & signature fails,
  1. ; if TIUADEL is present
  1. ; = -1^-1 if TIUES=1 and user deletes note
  1. ; Required Input parameters:
  1. ; DFN = Patient IFN in file #2
  1. ; TIUAUTH = Author IFN in file #200
  1. ; TIURDT = Date/time of note in FM format
  1. ; TIUTITLE = Title IFN in file 8925.1
  1. ; Required global variable:
  1. ; ^TMP("TIUP",$J) = Array root for text in format compatible
  1. ; w/FM Word-processing fields. e.g.,
  1. ; ^TMP("TIUP",$J,0)=^^1^1^2961216^
  1. ; ^TMP("TIUP",$J,1,0)=Testing the TIUPNAPI.
  1. ;
  1. ; NOTE: you no longer need to use the
  1. ; additional subscript to designate where
  1. ; the text should go (e.g., 10 for Admission
  1. ; Note).
  1. ; Optional Input variables:
  1. ; TIULOC = Patient Location IFN in file #44
  1. ; TIUES = 1 if TIU should prompt/process E-SIG
  1. ; TIUPRT = 1 if TIU should prompt user to print note
  1. ; TIUESBY = Signer IFN in file #200: Calling App is
  1. ; resonsible for Electronic Signature
  1. ; TIUASKVS = BOOLEAN flag indicating whether to ask for visit
  1. ; NOTE: If TIUESBY is passed, the document will be marked as
  1. ; signed at the time the encrypted signature block name
  1. ; and title are filed
  1. ; TIUADEL = BOOLEAN flag for automatic delete if TIUESBY>0 and
  1. ; signature fails instead of leaving UNSIGNED doc.
  1. ;****************
  1. ;
  1. N TIUX,TIUCHNG,TIUHIT,TIUPRM0,TIUPRM1,TIUTYP,TIUOUT,TIUDPRM,TIUVSTR
  1. N COSPROB,AUTHSIGN
  1. S TIUIFN=-1,COSPROB=0
  1. I $D(^TMP("TIUP",$J))'>9 Q ; If no text, quit
  1. I '$D(^DPT(+$G(DFN),0)) G EXIT ; if not valid patient, clean-up & quit
  1. I $L($$GET1^DIQ(200,+$G(TIUAUTH),.01))'>0 G EXIT ; if not valid author, clean-up & quit
  1. I '$D(^TIU(8925.1,+$G(TIUTITLE),0)) G EXIT ; if not valid title, clean-up & quit
  1. I $S(+$G(TIURDT)'>0:1,+$G(TIURDT)>+$$NOW^XLFDT:1,+$$FMTH^XLFDT(TIURDT)'>0:1,1:0) G EXIT
  1. I $S('($D(DUZ)#2):1,$L($$GET1^DIQ(200,DUZ,.01))'>0:1,1:0) G EXIT
  1. S TIUASKVS=+$G(TIUASKVS)
  1. ; -- Okay, create new note
  1. S TIUX(1202)=TIUAUTH,TIUX(1301)=TIURDT
  1. ; get doc parameters
  1. D DOCPRM^TIULC1(TIUTITLE,.TIUDPRM)
  1. I +TIUASKVS D G:+$G(TIUOUT) EXIT
  1. . N TIUBY,TIU,TIUY
  1. . D ENPN^TIUVSIT(.TIU,DFN,1)
  1. . I '$D(TIU) S TIUOUT=1,TIUIFN=-1 Q
  1. . S TIUY=$$CHEKPN^TIULD(.TIU,.TIUBY)
  1. . I '+TIUY S TIUOUT=1,TIUIFN=-1 Q
  1. . I '$L($G(TIU("VSTR"))) S TIUOUT=1,TIUIFN=-1 Q
  1. . S TIUVSTR=$G(TIU("VSTR")),TIULOC=+$G(TIU("LOC"))
  1. . I +$G(TIU("STOP")),(+$P(TIUDPRM(0),U,14)'=1) S TIUX(.11)=1
  1. M TIUX("TEXT")=^TMP("TIUP",$J)
  1. D MAKE^TIUSRVP(.TIUIFN,DFN,TIUTITLE,TIURDT,$G(TIULOC),"",.TIUX,$G(TIUVSTR))
  1. I +TIUIFN'>0 S TIUIFN=-1 G EXIT
  1. ; -- If author requires cosig, then
  1. ; If we're not interactive we can't get Exp Cos so we have
  1. ; a cosig problem:
  1. S AUTHSIGN=$S($G(TIUESBY):TIUESBY,1:TIUAUTH)
  1. I +$$REQCOSIG^TIULP(TIUTITLE,"",AUTHSIGN) D G:+$G(TIUOUT) EXIT
  1. . I $D(ZTQUEUED) S COSPROB=1 Q ; called from a task
  1. . I $D(XWBOS) S COSPROB=1 Q ; called from RPCBroker app
  1. . ; -- If we are interactive, get Exp Cos. Get it after note
  1. . ; is created since screen needs IFN:
  1. . N DIE,DA,DR,X,Y,COSNEED,EXPCOS
  1. . S COSNEED=1
  1. . S EXPCOS=$$GETCOSNR(+TIUIFN)
  1. . I EXPCOS'>0 D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN=-1,TIUOUT=1 Q
  1. . S DIE=8925,DR="1208////^S X=EXPCOS;1506////^S X=COSNEED",DA=+TIUIFN D ^DIE
  1. I '+$G(TIUESBY),(+$G(TIUES)>0) D I +$G(TIUOUT) G EXIT
  1. . N VALMBCK
  1. . ; -- Present Browse Screen so user can sign:
  1. . D EXSTNOTE^TIUBR1(DFN,TIUIFN) I '$D(^TIU(8925,+TIUIFN,0)) S TIUIFN="-1^-1",TIUOUT=1 Q
  1. . I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUIFN=TIUIFN_"^-1"
  1. ; -- If esig done by calling app:
  1. ; but there IS a cosig problem and caller doesn't want unsigned
  1. ; docmts left around, delete docmt:
  1. I +$G(TIUESBY),COSPROB,$G(TIUADEL) D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN="-1^-1" G EXIT
  1. ; but if unsigned is OK, leave it unsigned:
  1. I +$G(TIUESBY),COSPROB S TIUIFN=TIUIFN_"^-1"
  1. ; -- If esig done by calling app and no cosig problem,
  1. ; mark it signed. If sig fails and caller doesn't
  1. ; want unsigned docmts left around, delete docmt:
  1. I +$G(TIUESBY),'COSPROB D MARKSIGN(.TIUIFN,+$G(TIUESBY)) I +$G(TIUADEL),+$P(^TIU(8925,+TIUIFN,0),U,5)<6 D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN="-1^-1" G EXIT
  1. D SEND^TIUALRT(+TIUIFN)
  1. EXIT K ^TMP("TIUP",$J)
  1. Q
  1. WHATITLE(X) ; -- Given a freetext title, return pointer to file 8925.1
  1. Q $$WHATITLE^TIUPUTU(X)
  1. ;
  1. GETCOSNR(TIUIEN) ; Function Asks Expected Cosigner
  1. N TIUY,HELP
  1. S HELP="You may not select self, author, or others who require cosignature."
  1. S TIUY=$$READ^TIUU("P^200:AEMQ","EXPECTED COSIGNER","",HELP,"I $$SCRCSNR^TIULA3(TIUIEN,+Y)")
  1. Q +$G(TIUY)
  1. ;
  1. MARKSIGN(TIUDA,TIUESBY) ; Mark note as electronically signed
  1. N ESNAME,ESTITLE,ESBLOCK
  1. I $S(+$G(TIUESBY)'>0:1,$L($$GET1^DIQ(200,+$G(TIUESBY),.01))'>0:1,+$$CANDO^TIULP(TIUDA,"SIGNATURE",$G(TIUESBY))'>0:1,1:0) S TIUDA=TIUDA_U_-1 Q
  1. S ESNAME=$$GET1^DIQ(200,+TIUESBY,20.2),ESTITLE=$$GET1^DIQ(200,+TIUESBY,20.3)
  1. S ESBLOCK="1^"_ESNAME_U_ESTITLE
  1. D ES^TIURS(TIUDA,ESBLOCK)
  1. I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUDA=TIUDA_"^-1"
  1. Q
  1. TEST ; Interactive Test
  1. N DUOUT,DFN,TITLE,TIUTYP,TIURDT,TIUDA,DIC K ^TMP("TIUP",$J)
  1. W !,"First, collect the data to pass to the API...",!
  1. S DFN=+$$PATIENT^TIULA Q:+DFN'>0
  1. D DOCSPICK^TIULA2(.TIUTYP,3,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
  1. S TITLE=$P($G(TIUTYP(1)),U,2) Q:+TITLE'>0
  1. S TIURDT=+$$NOW^XLFDT
  1. S DIC="^TMP(""TIUP"",$J," D EN^DIWE
  1. W !,"NOW, call the API!",!
  1. D NEW(.TIUDA,DFN,DUZ,TIURDT,TITLE,"",1,1,"",1)
  1. Q