SDAMVSC.m

SDAMVSC ;;OIFO-BAY PINES/TEH - Appt Event Driver Utilities-Validate SC Appt type ; 12/1/91 [ 09/19/96  1:39 PM ]  ; Compiled August 20, 2007 14:28:26

 ;;5.3;Scheduling;**394,417,491,1015**;Aug 13, 1993;Build 21

 ;

 ;

 ;***************************************************************************************************************************

 ;

 ;                            ***** NOTE *****

 ;                                                   

 ;This software was created to be used with the SCHEDULING V5.3 appointment management package. The SRA API (SDAMA301)

 ;was employed to retrieve data from the PATIENT APPOINTMENT file (2.98) due inpart to VA Fileman non-compliance.

 ;

 ;DBIA #4433 SUBSCRIPTION 

 ;

 ;

 ;Entry Point EN. This routine requires the OUTPATIENT ENOUNTER IEN (variable SDOE)

 ;

 ;GLOBALS: ^SCE(IEN,0) (#.1) APPOINTMENT TYPE [10P:409.1]

 ;         ^DPT(IEN,"S",DATE,0)  ^ (#9.5) APPOINTMENT TYPE [16P:409.1]

 ;         ^SD(409.41,0)=OUTPATIENT CLASSIFCATION TYPE "Was treatment for SC Condition? " QUESTION FOR CHECKOUT.

 ;

 ;PROTOCOLS: This routine is called from the SDAM APPOINTMENT EVENTS.

 ;         

 ;This validates that both the OUTPATIENT ENCOUNTER and the PATIENT SCHEDULING NODES for APPOINTMENT TYPE are (pointer to

 ;409.1 APPOINTMENT TYPE) are set to the "SERVICE CONNECTED" appointment type when the response to the CLASSIFICATION TYPE

 ;"Was treatment for SC Condition?" question is answered "YES". If the question is answered "NO" and the APPOINTMENT TYPE

 ;is SERVICE CONNECTED, then the APPOINTMENT TYPE is reverted to REGULAR.

 ;

 ;

 ;****************************************************************************************************************************

 Q

EN ;Entry Point

 Q:'$G(SDOE)

 N SDN,SDVSCL,SDVSTD,SDAPDF,SDDPTYP,SDOED,SDVSTD,SDVDPTD,SDVSCD,SDSCV,SDAPPTY,SDAPDT,SDDFN,SDVSTD,SDIENS,SDARRAY,SDAPDF

 S SDOED=$G(^SCE(SDOE,0)) Q:SDOED=""

 S SDDFN=$P(SDOED,U,2),SDAPDT=$P(SDOED,U)

 ;GET APPOINTMENT FROM EVENT OUTPUT ARRAY

 I $G(^TMP("SDAMEVT",$J,"AFTER","DPT")) S SDAPDPT=$P($G(^TMP("SDAMEVT",$J,"AFTER","DPT")),"^",16)

 E  S SDAPDPT=$P(SDOED,"^",10) ;APP TYPE

 S SDVSCL=$P(SDOED,U,4)

 S SDVSTD=$P(SDOED,U,5)

 Q:'SDVSTD  ; ticket #194210 ; do not proceed if no pointer to a visit

 Q:'$D(^AUPNVSIT(SDVSTD,800))

 S SDSCV=+$$GET1^DIQ(9000010,SDVSTD_",",80001,"I") ;SC flag in Visit file

 S SDAPDF=$$GET1^DIQ(44,SDVSCL_",",2507,"I") ;default appt type

 ;find if credit stop secondary visit exists.

 N SDVSTDS,SDOE1 S SDOE1="" S SDVSTDS=$O(^AUPNVSIT("AD",SDVSTD,""))

 I SDVSTDS>0 S SDOE1=$O(^SCE("AVSIT",SDVSTDS,""))

 I SDSCV I SDAPDPT'=11 S SDAPDPT=11 D APPT F SDE=SDOE,SDOE1 I SDE>0 D SCE(SDE)

 I 'SDSCV I SDAPDPT=11 D  D APPT F SDE=SDOE,SDOE1 I SDE>0 D SCE(SDE)

 . I SDAPDF'="" S SDAPDPT=SDAPDF ; set to default if exists for this clinic

 . E  S SDAPDPT=9 ; set to regular

 Q

SCE(SDE) ;Set FDA for SCE(ien,0) OUTPATIENT ENCOUNTER

 S SDIENS=SDE_"," K ^TMP("SDAMSCE",$J)

 D FDA^DILF(409.68,SDIENS,.1,,SDAPDPT,"^TMP(""SDAMSCE"",$J)","^TMP(""SDAMSCE"",$J)")

 I $D(^TMP("SDAMSCE",$J,"DIERR")) D  Q

 .W !,"Processing Error ",^TMP("SDAMSCE",$J,"DIERR",1) Q

 D FILE^DIE(,"^TMP(""SDAMSCE"",$J)","^TMP(""SDAMSCE"",$J)")

 Q

APPT ;quit if clinic in event doesn't match clinic in ^DPT

 ;set up app type in DPT

 I +$G(^TMP("SDAMEVT",$J,"AFTER","DPT"))'=+$G(^DPT(SDDFN,"S",SDAPDT,0)) Q

 I $D(^DPT(SDDFN,"S",SDAPDT,0)) S $P(^DPT(SDDFN,"S",SDAPDT,0),U,16)=SDAPDPT

END Q

SDAMVSC   ;;OIFO-BAY PINES/TEH - Appt Event Driver Utilities-Validate SC Appt type ; 12/1/91 [ 09/19/96  1:39 PM ]  ; Compiled August 20, 2007 14:28:26

 +1       ;;5.3;Scheduling;**394,417,491,1015**;Aug 13, 1993;Build 21

 +2       ;

 +3       ;

 +4       ;***************************************************************************************************************************

 +5       ;

 +6       ;                            ***** NOTE *****

 +7       ;                                                   

 +8       ;This software was created to be used with the SCHEDULING V5.3 appointment management package. The SRA API (SDAMA301)

 +9       ;was employed to retrieve data from the PATIENT APPOINTMENT file (2.98) due inpart to VA Fileman non-compliance.

 +10      ;

 +11      ;DBIA #4433 SUBSCRIPTION 

 +12      ;

 +13      ;

 +14      ;Entry Point EN. This routine requires the OUTPATIENT ENOUNTER IEN (variable SDOE)

 +15      ;

 +16      ;GLOBALS: ^SCE(IEN,0) (#.1) APPOINTMENT TYPE [10P:409.1]

 +17      ;         ^DPT(IEN,"S",DATE,0)  ^ (#9.5) APPOINTMENT TYPE [16P:409.1]

 +18      ;         ^SD(409.41,0)=OUTPATIENT CLASSIFCATION TYPE "Was treatment for SC Condition? " QUESTION FOR CHECKOUT.

 +19      ;

 +20      ;PROTOCOLS: This routine is called from the SDAM APPOINTMENT EVENTS.

 +21      ;         

 +22      ;This validates that both the OUTPATIENT ENCOUNTER and the PATIENT SCHEDULING NODES for APPOINTMENT TYPE are (pointer to

 +23      ;409.1 APPOINTMENT TYPE) are set to the "SERVICE CONNECTED" appointment type when the response to the CLASSIFICATION TYPE

 +24      ;"Was treatment for SC Condition?" question is answered "YES". If the question is answered "NO" and the APPOINTMENT TYPE

 +25      ;is SERVICE CONNECTED, then the APPOINTMENT TYPE is reverted to REGULAR.

 +26      ;

 +27      ;

 +28      ;****************************************************************************************************************************

 +29       QUIT 

EN        ;Entry Point

 +1        IF '$GET(SDOE)

               QUIT 

 +2        NEW SDN,SDVSCL,SDVSTD,SDAPDF,SDDPTYP,SDOED,SDVSTD,SDVDPTD,SDVSCD,SDSCV,SDAPPTY,SDAPDT,SDDFN,SDVSTD,SDIENS,SDARRAY,SDAPDF

 +3        SET SDOED=$GET(^SCE(SDOE,0))

           IF SDOED=""

               QUIT 

 +4        SET SDDFN=$PIECE(SDOED,U,2)

           SET SDAPDT=$PIECE(SDOED,U)

 +5       ;GET APPOINTMENT FROM EVENT OUTPUT ARRAY

 +6        IF $GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT"))

               SET SDAPDPT=$PIECE($GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT")),"^",16)

 +7       ;APP TYPE

          IF '$TEST

               SET SDAPDPT=$PIECE(SDOED,"^",10)

 +8        SET SDVSCL=$PIECE(SDOED,U,4)

 +9        SET SDVSTD=$PIECE(SDOED,U,5)

 +10      ; ticket #194210 ; do not proceed if no pointer to a visit

           IF 'SDVSTD

               QUIT 

 +11       IF '$DATA(^AUPNVSIT(SDVSTD,800))

               QUIT 

 +12      ;SC flag in Visit file

           SET SDSCV=+$$GET1^DIQ(9000010,SDVSTD_",",80001,"I")

 +13      ;default appt type

           SET SDAPDF=$$GET1^DIQ(44,SDVSCL_",",2507,"I")

 +14      ;find if credit stop secondary visit exists.

 +15       NEW SDVSTDS,SDOE1

           SET SDOE1=""

           SET SDVSTDS=$ORDER(^AUPNVSIT("AD",SDVSTD,""))

 +16       IF SDVSTDS>0

               SET SDOE1=$ORDER(^SCE("AVSIT",SDVSTDS,""))

 +17       IF SDSCV

               IF SDAPDPT'=11

                   SET SDAPDPT=11

                   DO APPT

                   FOR SDE=SDOE,SDOE1

                       IF SDE>0

                           DO SCE(SDE)

 +18       IF 'SDSCV

               IF SDAPDPT=11

                   Begin DoDot:1

 +19      ; set to default if exists for this clinic

                       IF SDAPDF'=""

                           SET SDAPDPT=SDAPDF

 +20      ; set to regular

                      IF '$TEST

                           SET SDAPDPT=9

                   End DoDot:1

                   DO APPT

                   FOR SDE=SDOE,SDOE1

                       IF SDE>0

                           DO SCE(SDE)

 +21       QUIT 

SCE(SDE)  ;Set FDA for SCE(ien,0) OUTPATIENT ENCOUNTER

 +1        SET SDIENS=SDE_","

           KILL ^TMP("SDAMSCE",$JOB)

 +2        DO FDA^DILF(409.68,SDIENS,.1,,SDAPDPT,"^TMP(""SDAMSCE"",$J)","^TMP(""SDAMSCE"",$J)")

 +3        IF $DATA(^TMP("SDAMSCE",$JOB,"DIERR"))

               Begin DoDot:1

 +4                WRITE !,"Processing Error ",^TMP("SDAMSCE",$JOB,"DIERR",1)

                   QUIT 

               End DoDot:1

               QUIT 

 +5        DO FILE^DIE(,"^TMP(""SDAMSCE"",$J)","^TMP(""SDAMSCE"",$J)")

 +6        QUIT 

APPT      ;quit if clinic in event doesn't match clinic in ^DPT

 +1       ;set up app type in DPT

 +2        IF +$GET(^TMP("SDAMEVT",$JOB,"AFTER","DPT"))'=+$GET(^DPT(SDDFN,"S",SDAPDT,0))

               QUIT 

 +3        IF $DATA(^DPT(SDDFN,"S",SDAPDT,0))

               SET $PIECE(^DPT(SDDFN,"S",SDAPDT,0),U,16)=SDAPDPT

END        QUIT