TIUPNAPI ; SLC/JER - API to Replace GMRPAPI ; 8/8/05
;;1.0;TEXT INTEGRATION UTILITIES;**57,140,175,180,184**;Jun 20, 1997
;
; ^DPT( IA #3101
NEW(TIUIFN,DFN,TIUAUTH,TIURDT,TIUTITLE,TIULOC,TIUES,TIUPRT,TIUESBY,TIUASKVS,TIUADEL) ;
; -- Create new note
;****************
; Return variable (must pass by reference):
; TIUIFN (pass by ref) = New note IFN in file 8925, -1 if error,
; = IFN^-1 if note filed, w/o signature when
; TIUES=1 (It has been IFN^-1 as far back
; as patch 140. Noted on 8/4/05)
; = -1 if user fails to enter valid cosig
; = IFN^-1 if TIUESBY>0 & signature fails,
; if TIUADEL not present
; = -1^-1 if TIUESBY>0 & signature fails,
; if TIUADEL is present
; = -1^-1 if TIUES=1 and user deletes note
; Required Input parameters:
; DFN = Patient IFN in file #2
; TIUAUTH = Author IFN in file #200
; TIURDT = Date/time of note in FM format
; TIUTITLE = Title IFN in file 8925.1
; Required global variable:
; ^TMP("TIUP",$J) = Array root for text in format compatible
; w/FM Word-processing fields. e.g.,
; ^TMP("TIUP",$J,0)=^^1^1^2961216^
; ^TMP("TIUP",$J,1,0)=Testing the TIUPNAPI.
;
; NOTE: you no longer need to use the
; additional subscript to designate where
; the text should go (e.g., 10 for Admission
; Note).
; Optional Input variables:
; TIULOC = Patient Location IFN in file #44
; TIUES = 1 if TIU should prompt/process E-SIG
; TIUPRT = 1 if TIU should prompt user to print note
; TIUESBY = Signer IFN in file #200: Calling App is
; resonsible for Electronic Signature
; TIUASKVS = BOOLEAN flag indicating whether to ask for visit
; NOTE: If TIUESBY is passed, the document will be marked as
; signed at the time the encrypted signature block name
; and title are filed
; TIUADEL = BOOLEAN flag for automatic delete if TIUESBY>0 and
; signature fails instead of leaving UNSIGNED doc.
;****************
;
N TIUX,TIUCHNG,TIUHIT,TIUPRM0,TIUPRM1,TIUTYP,TIUOUT,TIUDPRM,TIUVSTR
N COSPROB,AUTHSIGN
S TIUIFN=-1,COSPROB=0
I $D(^TMP("TIUP",$J))'>9 Q ; If no text, quit
I '$D(^DPT(+$G(DFN),0)) G EXIT ; if not valid patient, clean-up & quit
I $L($$GET1^DIQ(200,+$G(TIUAUTH),.01))'>0 G EXIT ; if not valid author, clean-up & quit
I '$D(^TIU(8925.1,+$G(TIUTITLE),0)) G EXIT ; if not valid title, clean-up & quit
I $S(+$G(TIURDT)'>0:1,+$G(TIURDT)>+$$NOW^XLFDT:1,+$$FMTH^XLFDT(TIURDT)'>0:1,1:0) G EXIT
I $S('($D(DUZ)#2):1,$L($$GET1^DIQ(200,DUZ,.01))'>0:1,1:0) G EXIT
S TIUASKVS=+$G(TIUASKVS)
; -- Okay, create new note
S TIUX(1202)=TIUAUTH,TIUX(1301)=TIURDT
; get doc parameters
D DOCPRM^TIULC1(TIUTITLE,.TIUDPRM)
I +TIUASKVS D G:+$G(TIUOUT) EXIT
. N TIUBY,TIU,TIUY
. D ENPN^TIUVSIT(.TIU,DFN,1)
. I '$D(TIU) S TIUOUT=1,TIUIFN=-1 Q
. S TIUY=$$CHEKPN^TIULD(.TIU,.TIUBY)
. I '+TIUY S TIUOUT=1,TIUIFN=-1 Q
. I '$L($G(TIU("VSTR"))) S TIUOUT=1,TIUIFN=-1 Q
. S TIUVSTR=$G(TIU("VSTR")),TIULOC=+$G(TIU("LOC"))
. I +$G(TIU("STOP")),(+$P(TIUDPRM(0),U,14)'=1) S TIUX(.11)=1
M TIUX("TEXT")=^TMP("TIUP",$J)
D MAKE^TIUSRVP(.TIUIFN,DFN,TIUTITLE,TIURDT,$G(TIULOC),"",.TIUX,$G(TIUVSTR))
I +TIUIFN'>0 S TIUIFN=-1 G EXIT
; -- If author requires cosig, then
; If we're not interactive we can't get Exp Cos so we have
; a cosig problem:
S AUTHSIGN=$S($G(TIUESBY):TIUESBY,1:TIUAUTH)
I +$$REQCOSIG^TIULP(TIUTITLE,"",AUTHSIGN) D G:+$G(TIUOUT) EXIT
. I $D(ZTQUEUED) S COSPROB=1 Q ; called from a task
. I $D(XWBOS) S COSPROB=1 Q ; called from RPCBroker app
. ; -- If we are interactive, get Exp Cos. Get it after note
. ; is created since screen needs IFN:
. N DIE,DA,DR,X,Y,COSNEED,EXPCOS
. S COSNEED=1
. S EXPCOS=$$GETCOSNR(+TIUIFN)
. I EXPCOS'>0 D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN=-1,TIUOUT=1 Q
. S DIE=8925,DR="1208////^S X=EXPCOS;1506////^S X=COSNEED",DA=+TIUIFN D ^DIE
I '+$G(TIUESBY),(+$G(TIUES)>0) D I +$G(TIUOUT) G EXIT
. N VALMBCK
. ; -- Present Browse Screen so user can sign:
. D EXSTNOTE^TIUBR1(DFN,TIUIFN) I '$D(^TIU(8925,+TIUIFN,0)) S TIUIFN="-1^-1",TIUOUT=1 Q
. I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUIFN=TIUIFN_"^-1"
; -- If esig done by calling app:
; but there IS a cosig problem and caller doesn't want unsigned
; docmts left around, delete docmt:
I +$G(TIUESBY),COSPROB,$G(TIUADEL) D DELETE^TIUSRVP("",+TIUIFN,"",1) S TIUIFN="-1^-1" G EXIT
; but if unsigned is OK, leave it unsigned:
I +$G(TIUESBY),COSPROB S TIUIFN=TIUIFN_"^-1"
; -- If esig done by calling app and no cosig problem,
; mark it signed. If sig fails and caller doesn't
; want unsigned docmts left around, delete docmt:
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
D SEND^TIUALRT(+TIUIFN)
EXIT K ^TMP("TIUP",$J)
Q
WHATITLE(X) ; -- Given a freetext title, return pointer to file 8925.1
Q $$WHATITLE^TIUPUTU(X)
;
GETCOSNR(TIUIEN) ; Function Asks Expected Cosigner
N TIUY,HELP
S HELP="You may not select self, author, or others who require cosignature."
S TIUY=$$READ^TIUU("P^200:AEMQ","EXPECTED COSIGNER","",HELP,"I $$SCRCSNR^TIULA3(TIUIEN,+Y)")
Q +$G(TIUY)
;
MARKSIGN(TIUDA,TIUESBY) ; Mark note as electronically signed
N ESNAME,ESTITLE,ESBLOCK
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
S ESNAME=$$GET1^DIQ(200,+TIUESBY,20.2),ESTITLE=$$GET1^DIQ(200,+TIUESBY,20.3)
S ESBLOCK="1^"_ESNAME_U_ESTITLE
D ES^TIURS(TIUDA,ESBLOCK)
I +$P(^TIU(8925,+TIUIFN,0),U,5)<6 S TIUDA=TIUDA_"^-1"
Q
TEST ; Interactive Test
N DUOUT,DFN,TITLE,TIUTYP,TIURDT,TIUDA,DIC K ^TMP("TIUP",$J)
W !,"First, collect the data to pass to the API...",!
S DFN=+$$PATIENT^TIULA Q:+DFN'>0
D DOCSPICK^TIULA2(.TIUTYP,3,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
S TITLE=$P($G(TIUTYP(1)),U,2) Q:+TITLE'>0
S TIURDT=+$$NOW^XLFDT
S DIC="^TMP(""TIUP"",$J," D EN^DIWE
W !,"NOW, call the API!",!
D NEW(.TIUDA,DFN,DUZ,TIURDT,TITLE,"",1,1,"",1)
Q
TIUPNAPI ; SLC/JER - API to Replace GMRPAPI ; 8/8/05
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**57,140,175,180,184**;Jun 20, 1997
+2 ;
+3 ; ^DPT( IA #3101
NEW(TIUIFN,DFN,TIUAUTH,TIURDT,TIUTITLE,TIULOC,TIUES,TIUPRT,TIUESBY,TIUASKVS,TIUADEL) ;
+1 ; -- Create new note
+2 ;****************
+3 ; Return variable (must pass by reference):
+4 ; TIUIFN (pass by ref) = New note IFN in file 8925, -1 if error,
+5 ; = IFN^-1 if note filed, w/o signature when
+6 ; TIUES=1 (It has been IFN^-1 as far back
+7 ; as patch 140. Noted on 8/4/05)
+8 ; = -1 if user fails to enter valid cosig
+9 ; = IFN^-1 if TIUESBY>0 & signature fails,
+10 ; if TIUADEL not present
+11 ; = -1^-1 if TIUESBY>0 & signature fails,
+12 ; if TIUADEL is present
+13 ; = -1^-1 if TIUES=1 and user deletes note
+14 ; Required Input parameters:
+15 ; DFN = Patient IFN in file #2
+16 ; TIUAUTH = Author IFN in file #200
+17 ; TIURDT = Date/time of note in FM format
+18 ; TIUTITLE = Title IFN in file 8925.1
+19 ; Required global variable:
+20 ; ^TMP("TIUP",$J) = Array root for text in format compatible
+21 ; w/FM Word-processing fields. e.g.,
+22 ; ^TMP("TIUP",$J,0)=^^1^1^2961216^
+23 ; ^TMP("TIUP",$J,1,0)=Testing the TIUPNAPI.
+24 ;
+25 ; NOTE: you no longer need to use the
+26 ; additional subscript to designate where
+27 ; the text should go (e.g., 10 for Admission
+28 ; Note).
+29 ; Optional Input variables:
+30 ; TIULOC = Patient Location IFN in file #44
+31 ; TIUES = 1 if TIU should prompt/process E-SIG
+32 ; TIUPRT = 1 if TIU should prompt user to print note
+33 ; TIUESBY = Signer IFN in file #200: Calling App is
+34 ; resonsible for Electronic Signature
+35 ; TIUASKVS = BOOLEAN flag indicating whether to ask for visit
+36 ; NOTE: If TIUESBY is passed, the document will be marked as
+37 ; signed at the time the encrypted signature block name
+38 ; and title are filed
+39 ; TIUADEL = BOOLEAN flag for automatic delete if TIUESBY>0 and
+40 ; signature fails instead of leaving UNSIGNED doc.
+41 ;****************
+42 ;
+43 NEW TIUX,TIUCHNG,TIUHIT,TIUPRM0,TIUPRM1,TIUTYP,TIUOUT,TIUDPRM,TIUVSTR
+44 NEW COSPROB,AUTHSIGN
+45 SET TIUIFN=-1
SET COSPROB=0
+46 ; If no text, quit
IF $DATA(^TMP("TIUP",$JOB))'>9
QUIT
+47 ; if not valid patient, clean-up & quit
IF '$DATA(^DPT(+$GET(DFN),0))
GOTO EXIT
+48 ; if not valid author, clean-up & quit
IF $LENGTH($$GET1^DIQ(200,+$GET(TIUAUTH),.01))'>0
GOTO EXIT
+49 ; if not valid title, clean-up & quit
IF '$DATA(^TIU(8925.1,+$GET(TIUTITLE),0))
GOTO EXIT
+50 IF $SELECT(+$GET(TIURDT)'>0:1,+$GET(TIURDT)>+$$NOW^XLFDT:1,+$$FMTH^XLFDT(TIURDT)'>0:1,1:0)
GOTO EXIT
+51 IF $SELECT('($DATA(DUZ)#2):1,$LENGTH($$GET1^DIQ(200,DUZ,.01))'>0:1,1:0)
GOTO EXIT
+52 SET TIUASKVS=+$GET(TIUASKVS)
+53 ; -- Okay, create new note
+54 SET TIUX(1202)=TIUAUTH
SET TIUX(1301)=TIURDT
+55 ; get doc parameters
+56 DO DOCPRM^TIULC1(TIUTITLE,.TIUDPRM)
+57 IF +TIUASKVS
Begin DoDot:1
+58 NEW TIUBY,TIU,TIUY
+59 DO ENPN^TIUVSIT(.TIU,DFN,1)
+60 IF '$DATA(TIU)
SET TIUOUT=1
SET TIUIFN=-1
QUIT
+61 SET TIUY=$$CHEKPN^TIULD(.TIU,.TIUBY)
+62 IF '+TIUY
SET TIUOUT=1
SET TIUIFN=-1
QUIT
+63 IF '$LENGTH($GET(TIU("VSTR")))
SET TIUOUT=1
SET TIUIFN=-1
QUIT
+64 SET TIUVSTR=$GET(TIU("VSTR"))
SET TIULOC=+$GET(TIU("LOC"))
+65 IF +$GET(TIU("STOP"))
IF (+$PIECE(TIUDPRM(0),U,14)'=1)
SET TIUX(.11)=1
End DoDot:1
IF +$GET(TIUOUT)
GOTO EXIT
+66 MERGE TIUX("TEXT")=^TMP("TIUP",$JOB)
+67 DO MAKE^TIUSRVP(.TIUIFN,DFN,TIUTITLE,TIURDT,$GET(TIULOC),"",.TIUX,$GET(TIUVSTR))
+68 IF +TIUIFN'>0
SET TIUIFN=-1
GOTO EXIT
+69 ; -- If author requires cosig, then
+70 ; If we're not interactive we can't get Exp Cos so we have
+71 ; a cosig problem:
+72 SET AUTHSIGN=$SELECT($GET(TIUESBY):TIUESBY,1:TIUAUTH)
+73 IF +$$REQCOSIG^TIULP(TIUTITLE,"",AUTHSIGN)
Begin DoDot:1
+74 ; called from a task
IF $DATA(ZTQUEUED)
SET COSPROB=1
QUIT
+75 ; called from RPCBroker app
IF $DATA(XWBOS)
SET COSPROB=1
QUIT
+76 ; -- If we are interactive, get Exp Cos. Get it after note
+77 ; is created since screen needs IFN:
+78 NEW DIE,DA,DR,X,Y,COSNEED,EXPCOS
+79 SET COSNEED=1
+80 SET EXPCOS=$$GETCOSNR(+TIUIFN)
+81 IF EXPCOS'>0
DO DELETE^TIUSRVP("",+TIUIFN,"",1)
SET TIUIFN=-1
SET TIUOUT=1
QUIT
+82 SET DIE=8925
SET DR="1208////^S X=EXPCOS;1506////^S X=COSNEED"
SET DA=+TIUIFN
DO ^DIE
End DoDot:1
IF +$GET(TIUOUT)
GOTO EXIT
+83 IF '+$GET(TIUESBY)
IF (+$GET(TIUES)>0)
Begin DoDot:1
+84 NEW VALMBCK
+85 ; -- Present Browse Screen so user can sign:
+86 DO EXSTNOTE^TIUBR1(DFN,TIUIFN)
IF '$DATA(^TIU(8925,+TIUIFN,0))
SET TIUIFN="-1^-1"
SET TIUOUT=1
QUIT
+87 IF +$PIECE(^TIU(8925,+TIUIFN,0),U,5)<6
SET TIUIFN=TIUIFN_"^-1"
End DoDot:1
IF +$GET(TIUOUT)
GOTO EXIT
+88 ; -- If esig done by calling app:
+89 ; but there IS a cosig problem and caller doesn't want unsigned
+90 ; docmts left around, delete docmt:
+91 IF +$GET(TIUESBY)
IF COSPROB
IF $GET(TIUADEL)
DO DELETE^TIUSRVP("",+TIUIFN,"",1)
SET TIUIFN="-1^-1"
GOTO EXIT
+92 ; but if unsigned is OK, leave it unsigned:
+93 IF +$GET(TIUESBY)
IF COSPROB
SET TIUIFN=TIUIFN_"^-1"
+94 ; -- If esig done by calling app and no cosig problem,
+95 ; mark it signed. If sig fails and caller doesn't
+96 ; want unsigned docmts left around, delete docmt:
+97 IF +$GET(TIUESBY)
IF 'COSPROB
DO MARKSIGN(.TIUIFN,+$GET(TIUESBY))
IF +$GET(TIUADEL)
IF +$PIECE(^TIU(8925,+TIUIFN,0),U,5)<6
DO DELETE^TIUSRVP("",+TIUIFN,"",1)
SET TIUIFN="-1^-1"
GOTO EXIT
+98 DO SEND^TIUALRT(+TIUIFN)
EXIT KILL ^TMP("TIUP",$JOB)
+1 QUIT
WHATITLE(X) ; -- Given a freetext title, return pointer to file 8925.1
+1 QUIT $$WHATITLE^TIUPUTU(X)
+2 ;
GETCOSNR(TIUIEN) ; Function Asks Expected Cosigner
+1 NEW TIUY,HELP
+2 SET HELP="You may not select self, author, or others who require cosignature."
+3 SET TIUY=$$READ^TIUU("P^200:AEMQ","EXPECTED COSIGNER","",HELP,"I $$SCRCSNR^TIULA3(TIUIEN,+Y)")
+4 QUIT +$GET(TIUY)
+5 ;
MARKSIGN(TIUDA,TIUESBY) ; Mark note as electronically signed
+1 NEW ESNAME,ESTITLE,ESBLOCK
+2 IF $SELECT(+$GET(TIUESBY)'>0:1,$LENGTH($$GET1^DIQ(200,+$GET(TIUESBY),.01))'>0:1,+$$CANDO^TIULP(TIUDA,"SIGNATURE",$GET(TIUESBY))'>0:1,1:0)
SET TIUDA=TIUDA_U_-1
QUIT
+3 SET ESNAME=$$GET1^DIQ(200,+TIUESBY,20.2)
SET ESTITLE=$$GET1^DIQ(200,+TIUESBY,20.3)
+4 SET ESBLOCK="1^"_ESNAME_U_ESTITLE
+5 DO ES^TIURS(TIUDA,ESBLOCK)
+6 IF +$PIECE(^TIU(8925,+TIUIFN,0),U,5)<6
SET TIUDA=TIUDA_"^-1"
+7 QUIT
TEST ; Interactive Test
+1 NEW DUOUT,DFN,TITLE,TIUTYP,TIURDT,TIUDA,DIC
KILL ^TMP("TIUP",$JOB)
+2 WRITE !,"First, collect the data to pass to the API...",!
+3 SET DFN=+$$PATIENT^TIULA
IF +DFN'>0
QUIT
+4 DO DOCSPICK^TIULA2(.TIUTYP,3,"1A","","","+$$CANPICK^TIULP(+Y),+$$CANENTR^TIULP(+Y)")
+5 SET TITLE=$PIECE($GET(TIUTYP(1)),U,2)
IF +TITLE'>0
QUIT
+6 SET TIURDT=+$$NOW^XLFDT
+7 SET DIC="^TMP(""TIUP"",$J,"
DO EN^DIWE
+8 WRITE !,"NOW, call the API!",!
+9 DO NEW(.TIUDA,DFN,DUZ,TIURDT,TITLE,"",1,1,"",1)
+10 QUIT
