SDEC07PID ;ALB/BLB - VISTA SCHEDULING ;Jul 15, 2021@10:40
;;5.3;Scheduling;**805**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
CONSULTPID(SDAPTYP,DFN,PROVIEN,SAVESTRT,SDDDT,SDDFN,SDECNOTE,SDECRES) ;
N SDRIEN1,CFDA,ERRMSG,NCIEN,CSFDA,CSIEN,CSSIEN,CONSPIDIEN
S SDRIEN1=$P(SDAPTYP,"|",2)
D REQSET^SDEC07A($P(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES,SDDFN) ;MGH added 3 parameters to this call
; File full consult pid history entry
S CONSPIDIEN=$O(^SDEC(409.87,"B",SDRIEN1,0))
I '$D(^SDEC(409.87,"B",SDRIEN1)) D
.S CFDA(409.87,"+1,",.01)=SDRIEN1
.S CFDA(409.87,"+1,",.02)=DFN
.D UPDATE^DIE("","CFDA","NCIEN","ERRMSG") K CFDA
.I $D(ERRMSG) Q
.S CSFDA(409.871,"+1,"_NCIEN(1)_",",.01)=$$NOW^XLFDT
.S CSFDA(409.871,"+1,"_NCIEN(1)_",",1)=SDDDT
.S CSFDA(409.871,"+1,"_NCIEN(1)_",",2)=$$GET1^DIQ(200,DUZ,.01,"E")
.D UPDATE^DIE("","CSFDA","CSIEN") K CSFDA
.;File consult pid history subfile only
I $D(^SDEC(409.87,"B",SDRIEN1)) D
.I $$CONSPIDCHECK^SDEC07(SDRIEN1,SDDDT) D
..S CSFDA(409.871,"+1,"_CONSPIDIEN_",",.01)=$$NOW^XLFDT
..S CSFDA(409.871,"+1,"_CONSPIDIEN_",",1)=SDDDT
..S CSFDA(409.871,"+1,"_CONSPIDIEN_",",2)=$$GET1^DIQ(200,DUZ,.01,"E")
..D UPDATE^DIE("","CSFDA","CSSIEN","ERR") K CSFDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC07PID 1294 printed Oct 16, 2024@18:50:35 Page 2
SDEC07PID ;ALB/BLB - VISTA SCHEDULING ;Jul 15, 2021@10:40
+1 ;;5.3;Scheduling;**805**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
CONSULTPID(SDAPTYP,DFN,PROVIEN,SAVESTRT,SDDDT,SDDFN,SDECNOTE,SDECRES) ;
+1 NEW SDRIEN1,CFDA,ERRMSG,NCIEN,CSFDA,CSIEN,CSSIEN,CONSPIDIEN
+2 SET SDRIEN1=$PIECE(SDAPTYP,"|",2)
+3 ;MGH added 3 parameters to this call
DO REQSET^SDEC07A($PIECE(SDAPTYP,"|",2),PROVIEN,"",1,"",SDECNOTE,SAVESTRT,SDECRES,SDDFN)
+4 ; File full consult pid history entry
+5 SET CONSPIDIEN=$ORDER(^SDEC(409.87,"B",SDRIEN1,0))
+6 IF '$DATA(^SDEC(409.87,"B",SDRIEN1))
Begin DoDot:1
+7 SET CFDA(409.87,"+1,",.01)=SDRIEN1
+8 SET CFDA(409.87,"+1,",.02)=DFN
+9 DO UPDATE^DIE("","CFDA","NCIEN","ERRMSG")
KILL CFDA
+10 IF $DATA(ERRMSG)
QUIT
+11 SET CSFDA(409.871,"+1,"_NCIEN(1)_",",.01)=$$NOW^XLFDT
+12 SET CSFDA(409.871,"+1,"_NCIEN(1)_",",1)=SDDDT
+13 SET CSFDA(409.871,"+1,"_NCIEN(1)_",",2)=$$GET1^DIQ(200,DUZ,.01,"E")
+14 DO UPDATE^DIE("","CSFDA","CSIEN")
KILL CSFDA
+15 ;File consult pid history subfile only
End DoDot:1
+16 IF $DATA(^SDEC(409.87,"B",SDRIEN1))
Begin DoDot:1
+17 IF $$CONSPIDCHECK^SDEC07(SDRIEN1,SDDDT)
Begin DoDot:2
+18 SET CSFDA(409.871,"+1,"_CONSPIDIEN_",",.01)=$$NOW^XLFDT
+19 SET CSFDA(409.871,"+1,"_CONSPIDIEN_",",1)=SDDDT
+20 SET CSFDA(409.871,"+1,"_CONSPIDIEN_",",2)=$$GET1^DIQ(200,DUZ,.01,"E")
+21 DO UPDATE^DIE("","CSFDA","CSSIEN","ERR")
KILL CSFDA
End DoDot:2
End DoDot:1
+22 QUIT
