SDAMBAE6.m

SDAMBAE6 ;ALB/MJK - A/E Protocol; 11 FEB 1993 10:00 am

 ;;5.3;Scheduling;**27,132,76**;08/13/93

 ;; ;

EN ; -- AE entry point for SDAM ADD EDIT protocol

 ;    - assumes SDAMTYP, SDBEG and SDEND defined from appt mgt

 ;    - assumes SDFN is defined if SDAMTYP="P"

 ;

 S VALMBCK=""

 D FULL^VALM1

 S DFLG=0 I SDAMTYP="P" S DFN=SDFN D 2^VADPT I +VADM(6) D  Q:DFLG

 . I SDBEG>+VADM(6) W VADM(7) S DFLG=1 R ZX:10

 D FREE($S(SDAMTYP="P":SDFN,1:""))

ENQ Q

 ;

EN1 ; -- AE entry point for SDCO ADD EDIT NEW protocol

 ;    - assumes SDBEG and SDEND defined from co mgt

 N SDOE0

 S VALMBCK=""

 D FULL^VALM1

 S SDOE0=$G(^SCE(+$G(SDOE),0))

 D FREE(+$P(SDOE0,U,2))

ENQ1 Q

 ;

EN2 ; -- AE entry point for SDADDEDIT option

 S SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS","","","","","PO",-1,"AD",1)

 I +SDVISIT<-1 W !!,$P(SDVISIT,U,2)

ENQ2 Q

 ;

FREE(SDFN) ; -- ask to create a standalone stop

 N SDVISIT

 IF SDFN D

 . S SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS",SDFN,SDBEG,SDEND,"","PO",-1,"AD",1)

 ELSE  D

 . S SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS","",SDBEG,SDEND,"","PO",-1,"AD",1)

 I +SDVISIT<-1 W !!,$P(SDVISIT,U,2)

 S VALMBCK="R"

 ;

FREEQ Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDAMBAE6   1182     printed  Apr 09, 2024@21:44:30                                                                                                                                                                                                    Page 2

SDAMBAE6  ;ALB/MJK - A/E Protocol; 11 FEB 1993 10:00 am

 +1       ;;5.3;Scheduling;**27,132,76**;08/13/93

 +2       ;; ;

EN        ; -- AE entry point for SDAM ADD EDIT protocol

 +1       ;    - assumes SDAMTYP, SDBEG and SDEND defined from appt mgt

 +2       ;    - assumes SDFN is defined if SDAMTYP="P"

 +3       ;

 +4        SET VALMBCK=""

 +5        DO FULL^VALM1

 +6        SET DFLG=0

           IF SDAMTYP="P"

               SET DFN=SDFN

               DO 2^VADPT

               IF +VADM(6)

                   Begin DoDot:1

 +7                    IF SDBEG>+VADM(6)

                           WRITE VADM(7)

                           SET DFLG=1

                           READ ZX:10

                   End DoDot:1

                   if DFLG

                       QUIT 

 +8        DO FREE($SELECT(SDAMTYP="P":SDFN,1:""))

ENQ        QUIT 

 +1       ;

EN1       ; -- AE entry point for SDCO ADD EDIT NEW protocol

 +1       ;    - assumes SDBEG and SDEND defined from co mgt

 +2        NEW SDOE0

 +3        SET VALMBCK=""

 +4        DO FULL^VALM1

 +5        SET SDOE0=$GET(^SCE(+$GET(SDOE),0))

 +6        DO FREE(+$PIECE(SDOE0,U,2))

ENQ1       QUIT 

 +1       ;

EN2       ; -- AE entry point for SDADDEDIT option

 +1        SET SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS","","","","","PO",-1,"AD",1)

 +2        IF +SDVISIT<-1

               WRITE !!,$PIECE(SDVISIT,U,2)

ENQ2       QUIT 

 +1       ;

FREE(SDFN) ; -- ask to create a standalone stop

 +1        NEW SDVISIT

 +2        IF SDFN

               Begin DoDot:1

 +3                SET SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS",SDFN,SDBEG,SDEND,"","PO",-1,"AD",1)

               End DoDot:1

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET SDVISIT=$$ENCEDIT^PXAPI("ADDEDIT","SD","PIMS","",SDBEG,SDEND,"","PO",-1,"AD",1)

               End DoDot:1

 +6        IF +SDVISIT<-1

               WRITE !!,$PIECE(SDVISIT,U,2)

 +7        SET VALMBCK="R"

 +8       ;

FREEQ      QUIT 

 +1       ;