- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPNAPI 6835 printed Feb 19, 2025@00:09:42 Page 2
- 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