SDEC07PID.m

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 ---SDEC07PID   1294     printed  Apr 09, 2024@21:53:17                                                                                                                                                                                                   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