- TIUSRVP2 ; SLC/JER - More RPCs related to note actions ;8/15/05
- ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
- MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ; Create addendum
- N DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU S TIUFPRIV=1
- N PTIEN,SUCCESS
- S TIUCAN=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM")
- I TIUCAN'>0 S TIUDADD="0^You may not MAKE AN ADDENDUM for this "_$$STATUS^TIULC(TIUDA)_" "_$$PNAME^TIULC1(+$G(^TIU(8925,+TIUDA,0))) Q
- S TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
- S (DIC,DLAYGO)=8925,DIC(0)="L",X=""""_"`"_TIUATYP_""""
- D ^DIC
- S TIUDADD=+Y
- I +Y'>0 S TIUDADD=TIUDADD_"^Could not create addendum." Q
- D GETTIU^TIULD(.TIU,TIUDA)
- S TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
- S PTIEN=$P(^TIU(8925,TIUDA,0),U,2)
- D STUFREC^TIUSRVP1(+TIUDADD,.TIUX,PTIEN,+$G(TIUDA),TIUATYP,.TIU)
- K ^TIU(8925,+TIUDADD,"TEMP")
- M ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
- D SETXT0^TIUSRVP(+TIUDADD)
- D FILE^TIUSRVP(.SUCCESS,+TIUDADD,.TIUX,+$G(SUPPRESS))
- I +SUCCESS'>0 D DIK^TIURB2(TIUDADD) S TIUDADD="-1^Could not create addendum." Q
- I +$O(^TIU(8925,+TIUDADD,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
- I '+$G(SUPPRESS) D RELEASE^TIUT(+TIUDADD,1)
- K ^TIU(8925,+TIUDADD,"TEMP")
- Q
- SETCOS(TIUDA,TIUX,TIUD0,TIUD12) ; set cosig req
- N TIUDAD,TIUEXS,TIUNCS,TIUEXCS,TIURCS,TIUATT,TIUTTL,TIUDAD0
- S TIUEXS=$S(+$G(TIUX(1202)):+$G(TIUX(1202)),1:$P(TIUD12,U,4))
- S TIUNCS=$S(+$G(TIUX(1208)):+$G(TIUX(1208)),+$G(TIUX(1209)):+$G(TIUX(1209)),1:0)
- I TIUNCS S TIUX(1506)=$S(TIUNCS=TIUEXS:0,1:1) G SETCOSX
- S TIUEXCS=$P(TIUD12,U,8),TIUATT=$P(TIUD12,U,9)
- S TIUDAD=+$P(TIUD0,U,6),TIUDAD0=$G(^TIU(8925,+TIUDAD,0))
- I +$$ISDS^TIULX($S(+TIUDAD:+TIUDAD0,1:+TIUD0)) D G SETCOSX
- . S TIUX(1506)=$S(TIUEXS=TIUEXCS:0,1:1)
- S TIUTTL=$S(+$G(TIUX(.01)):+$G(TIUX(.01)),1:+TIUD0)
- S TIUX(1506)=+$$REQCOSIG^TIULP(TIUTTL,TIUDA,TIUEXS)
- SETCOSX S:'TIUX(1506) TIUX(1208)="@"
- Q
- SIGN(ERR,TIUDA,TIUX) ; API for /es/
- N X,TIUACT,TIUSIGN,TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,VALID,XTRASGNR
- N TIUES S ERR=0
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUD12=$G(^TIU(8925,+TIUDA,12))
- S SIGNER=$P(TIUD12,U,4),COSIGNER=$P(TIUD12,U,8)
- I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
- I $G(XTRASGNR),+$P($G(^TIU(8925.7,$G(XTRASGNR),0)),U,4) S XTRASGNR=""
- I '$G(XTRASGNR) S XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
- S TIUSTAT=+$P(TIUD0,U,5)
- S TIUACT=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
- S TIUSIGN=$$CANDO^TIULP(TIUDA,TIUACT)
- I +TIUSIGN'>0 S ERR="89250004^"_$P(TIUSIGN,U,2) Q
- S VALID=$$VALIDATE($$DECRYP^XUSRB1(TIUX))
- I +VALID'>0 S ERR="89250005^"_$$EZBLD^DIALOG(89250005) Q
- S TIUES=1_U_$$GET1^DIQ(200,+DUZ,20.2)_U_$$GET1^DIQ(200,+DUZ,20.3)
- I '+$G(XTRASGNR) D ES^TIURS(TIUDA,TIUES)
- I +$G(XTRASGNR) D ADDSIG^TIURS1(TIUDA,XTRASGNR)
- I +$G(^TIU(8925,TIUDA,21)),(TIUACT="SIGNATURE") D AUDLINK^TIUGR1(TIUDA,"a",+$G(^TIU(8925,TIUDA,21)))
- Q
- VALIDATE(X) ; Validate /es/-code
- N TIUY S TIUY=0
- D HASH^XUSHSHP I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S TIUY=1
- Q TIUY
- TIUSRVP2 ; SLC/JER - More RPCs related to note actions ;8/15/05
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**184**;Jun 20, 1997
- MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ; Create addendum
- +1 NEW DIE,DR,DA,DIC,X,Y,DLAYGO,TIUATYP,TIUCAN,TIUFPRIV,TIU
- SET TIUFPRIV=1
- +2 NEW PTIEN,SUCCESS
- +3 SET TIUCAN=$$CANDO^TIULP(TIUDA,"MAKE ADDENDUM")
- +4 IF TIUCAN'>0
- SET TIUDADD="0^You may not MAKE AN ADDENDUM for this "_$$STATUS^TIULC(TIUDA)_" "_$$PNAME^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
- QUIT
- +5 SET TIUATYP=+$$WHATITLE^TIUPUTU("ADDENDUM")
- +6 SET (DIC,DLAYGO)=8925
- SET DIC(0)="L"
- SET X=""""_"`"_TIUATYP_""""
- +7 DO ^DIC
- +8 SET TIUDADD=+Y
- +9 IF +Y'>0
- SET TIUDADD=TIUDADD_"^Could not create addendum."
- QUIT
- +10 DO GETTIU^TIULD(.TIU,TIUDA)
- +11 SET TIU("DOCTYP")=TIUATYP_U_$$PNAME^TIULC1(TIUATYP)
- +12 SET PTIEN=$PIECE(^TIU(8925,TIUDA,0),U,2)
- +13 DO STUFREC^TIUSRVP1(+TIUDADD,.TIUX,PTIEN,+$GET(TIUDA),TIUATYP,.TIU)
- +14 KILL ^TIU(8925,+TIUDADD,"TEMP")
- +15 MERGE ^TIU(8925,+TIUDADD,"TEMP")=TIUX("TEXT")
- KILL TIUX("TEXT")
- +16 DO SETXT0^TIUSRVP(+TIUDADD)
- +17 DO FILE^TIUSRVP(.SUCCESS,+TIUDADD,.TIUX,+$GET(SUPPRESS))
- +18 IF +SUCCESS'>0
- DO DIK^TIURB2(TIUDADD)
- SET TIUDADD="-1^Could not create addendum."
- QUIT
- +19 IF +$ORDER(^TIU(8925,+TIUDADD,"TEMP",0))
- DO MERGTEXT^TIUEDI1(+TIUDADD,.TIU)
- +20 IF '+$GET(SUPPRESS)
- DO RELEASE^TIUT(+TIUDADD,1)
- +21 KILL ^TIU(8925,+TIUDADD,"TEMP")
- +22 QUIT
- SETCOS(TIUDA,TIUX,TIUD0,TIUD12) ; set cosig req
- +1 NEW TIUDAD,TIUEXS,TIUNCS,TIUEXCS,TIURCS,TIUATT,TIUTTL,TIUDAD0
- +2 SET TIUEXS=$SELECT(+$GET(TIUX(1202)):+$GET(TIUX(1202)),1:$PIECE(TIUD12,U,4))
- +3 SET TIUNCS=$SELECT(+$GET(TIUX(1208)):+$GET(TIUX(1208)),+$GET(TIUX(1209)):+$GET(TIUX(1209)),1:0)
- +4 IF TIUNCS
- SET TIUX(1506)=$SELECT(TIUNCS=TIUEXS:0,1:1)
- GOTO SETCOSX
- +5 SET TIUEXCS=$PIECE(TIUD12,U,8)
- SET TIUATT=$PIECE(TIUD12,U,9)
- +6 SET TIUDAD=+$PIECE(TIUD0,U,6)
- SET TIUDAD0=$GET(^TIU(8925,+TIUDAD,0))
- +7 IF +$$ISDS^TIULX($SELECT(+TIUDAD:+TIUDAD0,1:+TIUD0))
- Begin DoDot:1
- +8 SET TIUX(1506)=$SELECT(TIUEXS=TIUEXCS:0,1:1)
- End DoDot:1
- GOTO SETCOSX
- +9 SET TIUTTL=$SELECT(+$GET(TIUX(.01)):+$GET(TIUX(.01)),1:+TIUD0)
- +10 SET TIUX(1506)=+$$REQCOSIG^TIULP(TIUTTL,TIUDA,TIUEXS)
- SETCOSX IF 'TIUX(1506)
- SET TIUX(1208)="@"
- +1 QUIT
- SIGN(ERR,TIUDA,TIUX) ; API for /es/
- +1 NEW X,TIUACT,TIUSIGN,TIUD0,TIUD12,TIUSTAT,SIGNER,COSIGNER,VALID,XTRASGNR
- +2 NEW TIUES
- SET ERR=0
- +3 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUD12=$GET(^TIU(8925,+TIUDA,12))
- +4 SET SIGNER=$PIECE(TIUD12,U,4)
- SET COSIGNER=$PIECE(TIUD12,U,8)
- +5 IF (DUZ'=SIGNER)
- IF (DUZ'=COSIGNER)
- SET XTRASGNR=+$ORDER(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
- +6 IF $GET(XTRASGNR)
- IF +$PIECE($GET(^TIU(8925.7,$GET(XTRASGNR),0)),U,4)
- SET XTRASGNR=""
- +7 IF '$GET(XTRASGNR)
- SET XTRASGNR=$$ASURG^TIUADSIG(TIUDA)
- +8 SET TIUSTAT=+$PIECE(TIUD0,U,5)
- +9 SET TIUACT=$SELECT(TIUSTAT'>5:"SIGNATURE",+$GET(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
- +10 SET TIUSIGN=$$CANDO^TIULP(TIUDA,TIUACT)
- +11 IF +TIUSIGN'>0
- SET ERR="89250004^"_$PIECE(TIUSIGN,U,2)
- QUIT
- +12 SET VALID=$$VALIDATE($$DECRYP^XUSRB1(TIUX))
- +13 IF +VALID'>0
- SET ERR="89250005^"_$$EZBLD^DIALOG(89250005)
- QUIT
- +14 SET TIUES=1_U_$$GET1^DIQ(200,+DUZ,20.2)_U_$$GET1^DIQ(200,+DUZ,20.3)
- +15 IF '+$GET(XTRASGNR)
- DO ES^TIURS(TIUDA,TIUES)
- +16 IF +$GET(XTRASGNR)
- DO ADDSIG^TIURS1(TIUDA,XTRASGNR)
- +17 IF +$GET(^TIU(8925,TIUDA,21))
- IF (TIUACT="SIGNATURE")
- DO AUDLINK^TIUGR1(TIUDA,"a",+$GET(^TIU(8925,TIUDA,21)))
- +18 QUIT
- VALIDATE(X) ; Validate /es/-code
- +1 NEW TIUY
- SET TIUY=0
- +2 DO HASH^XUSHSHP
- IF X]""
- IF (X=$PIECE($GET(^VA(200,+DUZ,20)),U,4))
- SET TIUY=1
- +3 QUIT TIUY