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

DVBSIGN.m

Go to the documentation of this file. 
  1. DVBSIGN ;ALB/CP - CAPRI Signature RPCS; July, 2 2024@08:34 ; 7/2/24 8:35am
  1.  ;;2.7;AMIE;**252**;Apr 10, 1995;Build 92
  1.  ; Per VHA Directive 6402 this routine should not be modified
  1.  ; Reference to $$NOW^XLFDT in ICR #10103
  1.  ; Reference to ^TIU(8925 in IA #3376
  1.  ; Reference to $$GET1^DIQ(2 in DBIA #10035
  1.  ;
  1.  Q
  1.  ;
  1. SAVESIGN(DVBRTN,DVBIEN,DVBCOSIGNER) ;
  1.  ;;New Routine for Signer Saves CAPRI-11532 CP 7-2-24
  1.  N DVBSIGNER,DVBFLAG,DVBDT,DVBDATA,DVBERR
  1.  S DVBSIGNER=DUZ
  1.  S DVBDT=$$NOW^XLFDT
  1.  S DVBDATA(396.17,DVBIEN_",",4)=DVBDT
  1.  S DVBFLAG=$S(DVBCOSIGNER="":"0",1:1)
  1.  S DVBDATA(396.17,DVBIEN_",",29)=DVBFLAG
  1.  ;If yes then set DUZ, flag, and Update status to "U" for Uncosigned
  1.  I DVBFLAG=1 D
  1.  . S DVBDATA(396.17,DVBIEN_",",11)="U"
  1.  . S DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
  1.  . S DVBDATA(396.17,DVBIEN_",",30)=DVBCOSIGNER
  1.  . K DVBERR D FILE^DIE(,"DVBDATA","DVBERR")
  1.  . I $D(DVBERR)>0 S DVBRTN="-1^Details not Saved"
  1.  . I $D(DVBERR)=0 S DVBRTN="2^Signed Ready for CoSignature"
  1.  . Q
  1.  ;If no then set DUZ and set Status to "G" for Signed
  1.  I DVBFLAG=0 D
  1.  . S DVBDATA(396.17,DVBIEN_",",11)="G"
  1.  . S DVBDATA(396.17,DVBIEN_",",28)=DVBSIGNER
  1.  . S DVBDATA(396.17,DVBIEN_",",30)=""
  1.  . K DVBERR D FILE^DIE(,"DVBDATA","DVBERR")
  1.  . I $D(DVBERR)>0 S DVBRTN="-1^Details not Saved"
  1.  . I $D(DVBERR)=0 S DVBRTN="1^Signed Ready for Transmission"
  1.  . Q
  1.  Q
  1. ALERTCNT(DVBRTN) ;
  1.  ;;New RPC for Cosign Count CAPRI-11533 CP 7-26-24
  1.  ;;RPC: DVBA CAPRI UNCOSIGN COUNT 
  1.  N DVBIEN,DVBSTAT,DVBCNT
  1.  S (DVBIEN,DVBSTAT)=""
  1.  S DVBCNT=0
  1.  F  S DVBIEN=$O(^DVB(396.17,"H",DUZ,DVBIEN)) Q:DVBIEN=""  D
  1.  . S DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
  1.  . I DVBSTAT'="U" Q
  1.  . S DVBCNT=DVBCNT+1
  1.  S DVBRTN=DVBCNT
  1.  Q
  1.  ;
  1. UNCSINFO(DVBRTN) ;
  1.  ;New RPC code for CAPRI-11533.  JD - 7/11/24
  1.  ;RPC: DVBA CAPRI UNCOSIGNED INFO
  1.  ; 
  1.  N DVBCNT,DVBCPFL,DVBCPTX,DVBDTUPE,DVBDTUPI,DVBIEN,DVBPTIE,DVBPTNM,DVBSTAT,DVBTIUDM,DVBTIUDN
  1.  S (DVBIEN,DVBSTAT)="",DVBCNT=0
  1.  K ^TMP("UNCOSIGNALERTINFO",$J)
  1.  F  S DVBIEN=$O(^DVB(396.17,"H",DUZ,DVBIEN)) Q:DVBIEN=""  D
  1.  . S DVBSTAT=$$GET1^DIQ(396.17,DVBIEN,11,"I")
  1.  . I DVBSTAT'="U" Q  ;Only the Review Status of Uncosigned is allowed
  1.  . S DVBPTIE=$$GET1^DIQ(396.17,DVBIEN,.01,"I")  ;Patient IEN
  1.  . S DVBPTNM=$$GET1^DIQ(396.17,DVBIEN,.01,"E")  ;Patient name
  1.  . S DVBDTUPE=$$GET1^DIQ(396.17,DVBIEN,4,"E")   ;Date/time updated (External format)
  1.  . S DVBDTUPI=$$GET1^DIQ(396.17,DVBIEN,4,"I")   ;Date/time updated (Fileman format)
  1.  . S DVBCPFL=$$GET1^DIQ(396.17,DVBIEN,25,"I")   ;VHA internal DBQ referral(Y/N)
  1.  . S DVBTIUDN=$$GET1^DIQ(396.17,DVBIEN,7,"I")   ;TIU document number
  1.  . S DVBTIUDM=$$GET1^DIQ(8925,DVBTIUDN,.01,"E") ;TIU document name
  1.  . S DVBCPTX=$S(DVBCPFL="N":"",1:"NON-")
  1.  . S DVBCPTX="UNCOSIGNED "_DVBCPTX_DVBTIUDM_" available for COSIGNATURE"
  1.  . S DVBCNT=DVBCNT+1
  1.  . S ^TMP("UNCOSIGNALERTINFO",$J,-DVBDTUPI,DVBCNT)=DVBPTIE_U_DVBPTNM_U_DVBDTUPE_U_DVBCPTX_U_DVBIEN_U_DVBTIUDN
  1.  I DVBCNT'>0 S DVBRTN="-1^No data available" Q
  1.  S DVBRTN=$NA(^TMP("UNCOSIGNALERTINFO",$J))
  1.  Q
  1. REVIEWSAVE(DVBRTN,DVBIEN,DVBTYP,DVBREVCMT) ;
  1.  ;;New RPC for Review Updates CAPRI-12506 CP-8/13/24
  1.  ;;DVBA CAPRI SAVE REVIEW DATA
  1.  N DVBDTTM,DVBREVSEQ,DVBAFDA,DVBDOCMAN,DVBERR,DVBNEXTSEQ
  1.  ;;'P' FOR REVIEW PENDING;'S' FOR SENT BACK;'A' FOR AWAITING SIGNATURE;'T' for Trainee Details 
  1.  K DIC,DIE,DA,DR,DLAYGO,X,Y
  1.  ;;
  1.  I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
  1.  I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
  1.  I "TPSA"'[DVBTYP S DVBRTN="-1^Invalid Status" Q
  1.  I DVBTYP="T",$G(DVBREVCMT(1))'?1"TRAINEE^".N1"^".N S DVBRTN="-1^Invalid Comments" Q
  1.  I DVBTYP="T",$D(^VA(200,$P($G(DVBREVCMT(1)),"^",2)))<10 S DVBRTN="-1^Invalid Trainee DUZ" Q
  1.  I DVBTYP="A",$G(DVBREVCMT(1))'?.N,$D(^VA(200,$G(DVBREVCMT(1))))<10 S DVBRTN="-1^Invalid Signer DUZ" Q
  1.  ;;
  1.  S DVBDTTM=$$NOW^XLFDT
  1.  I DVBTYP="P" S DVBSIGNER=DUZ
  1.  I DVBTYP="A" S DVBDOCMAN=$G(DVBREVCMT(1))
  1.  I DVBTYP="A" S DVBREVCMT(1)="Sending for Signature"
  1.  S DVBREVSEQ=$P($G(^DVB(396.17,DVBIEN,6,0)),"^",3)
  1.  S DA(1)=DVBIEN,DA=DVBREVSEQ+1,X=DVBDTTM
  1.  S (DLAYGO,DIC)="^DVB(396.17,"_DA(1)_",6,",DIC(0)="LZ"
  1.  D ^DIC
  1.  I Y=-1 K DIC S DVBRTN="-1^New version not saved" Q
  1.  S DVBNEXTSEQ=+Y
  1.  S DIE=DIC
  1.  S DR=".01///"_DVBDTTM_";1///"_DUZ
  1.  D ^DIE
  1.  I $G(DVBREVCMT(1))'="" D WP^DIE(396.1714,DVBNEXTSEQ_","_DVBIEN_",",4,"K","DVBREVCMT","DVBERR")
  1.  I $D(DVBERR) S DVBRTN="-1^Review Comments not saved" Q
  1.  I '$D(DVBERR) S DVBRTN=1
  1.  I DVBTYP="T" S DVBRTN="1^Trainee DUZ and DIV Saved" Q
  1.  S DVBAFDA(396.17,DVBIEN_",",4)=DVBDTTM
  1.  S DVBAFDA(396.17,DVBIEN_",",11)=DVBTYP
  1.  S DVBAFDA(396.17,DVBIEN_",",19)="1"
  1.  I DVBTYP="P" S DVBAFDA(396.17,DVBIEN_",",28)=DVBSIGNER,DVBAFDA(396.17,DVBIEN_",",29)=0
  1.  I DVBTYP="S" S DVBAFDA(396.17,DVBIEN_",",2)=$P($G(^DVB(396.17,DVBIEN,16)),U,1)
  1.  I DVBTYP="A" S DVBAFDA(396.17,DVBIEN_",",2)=DVBDOCMAN
  1.  K DVBERR D FILE^DIE(,"DVBAFDA","DVBERR")
  1.  I $D(DVBERR)>0 S DVBRTN="-1^Worksheet not updated"
  1.  I $D(DVBERR)=0 S DVBRTN="1^Review Details saved and Worksheet Updated"
  1.  Q
  1. DOCMAN(DVBRTN,DVBIEN) ;
  1.  ;;Used B4 signature validation CAPRI-12506 CP-8/13/24
  1.  ;;DVBA CAPRI TRAINEE DOC MANAGER 
  1.  S DVBRTN="-1^No Update"
  1.  I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
  1.  I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
  1.  S DVBTRAINEE=$P($G(^DVB(396.17,DVBIEN,16)),U,1)
  1.  K DIE,DA,DR,X,Y
  1.  S DIE=396.17,DA=DVBIEN,DR="2///"_DVBTRAINEE
  1.  D ^DIE
  1.  S DVBRTN=1
  1.  K DVBTRAINEE
  1.  Q
  1. TRAINSIG(DVBRTN,DVBIEN) ;
  1.  ;;Send the DUZ and DIV for the Trainee CAPRI-12506 CP-8/13/24
  1.  ;;DVBA CAPRI TRAINEE SIGNATURE
  1.  N DVBDATA,DVBMULT
  1.  S DVBRTN=""
  1.  I DVBIEN="" S DVBRTN="-1^No Worksheet IEN sent" Q
  1.  I $D(^DVB(396.17,DVBIEN))<10 S DVBRTN="-1^Invalid Worksheet IEN" Q
  1.  I $D(^DVB(396.17,DVBIEN,6))<10 S DVBRTN="-1^No Review Data Saved"
  1.  S DVBMULT=""
  1.  F  S DVBMULT=$O(^DVB(396.17,DVBIEN,6,DVBMULT)) Q:DVBMULT=""  Q:DVBRTN'=""  D
  1.  . S DVBDATA=$G(^DVB(396.17,DVBIEN,6,DVBMULT,1,1,0))
  1.  . I $P(DVBDATA,U,1)="TRAINEE" S DVBRTN=$P(DVBDATA,U,2,3) Q
  1.  I DVBRTN="" S DVBRTN="-1^No details found" Q
  1.  Q
  1.  ;
  1. STATCNT(DVBRTN) ;
  1.  ;New RPC code for CAPRI-12825.  JD - 8/14/24
  1.  ;RPC: DVBA CAPRI STATUS COUNT
  1.  ;Added statuses D=Draft/Not Ready and O=Outdated Template.  JD - 8/21/24
  1.  ;
  1.  ;Returns the count for the following worksheet review statuses:
  1.  ;A=Awaiting Signature, D=Draft/Not ready, O=Outdated Template, P=Review Pending, S=Sent Back
  1.  ;
  1.  N DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS,DVBIEN,DVBP,DVBSTAT
  1.  S (DVBSTAT,DVBRTN)=""
  1.  S (DVBCNTA,DVBCNTD,DVBCNTO,DVBCNTP,DVBCNTS)=0
  1.  F  S DVBSTAT=$O(^DVB(396.17,"RS",DVBSTAT)) Q:DVBSTAT=""  D
  1.  . I "ADOPS"'[DVBSTAT Q
  1.  . S DVBIEN=""
  1.  . F  S DVBIEN=$O(^DVB(396.17,"RS",DVBSTAT,DVBIEN)) Q:DVBIEN=""  D
  1.  .. S DVBP="" D PASCALCHK^DVBCTPDF(.DVBP,DVBIEN) I DVBP="P" Q  ;CMT worksheets only!
  1.  .. I DVBSTAT="P" S DVBCNTP=DVBCNTP+1
  1.  .. I DUZ'=$$GET1^DIQ(396.17,DVBIEN,2,"I") Q  ;Document Manager
  1.  .. I DVBSTAT="A" S DVBCNTA=DVBCNTA+1
  1.  .. I DVBSTAT="D" S DVBCNTD=DVBCNTD+1
  1.  .. I DVBSTAT="O" S DVBCNTO=DVBCNTO+1
  1.  .. I DVBSTAT="S" S DVBCNTS=DVBCNTS+1
  1.  S DVBRTN=DVBCNTA_U_DVBCNTD_U_DVBCNTO_U_DVBCNTP_U_DVBCNTS
  1.  Q