- SCMCDDA ;bp/cmf - extension of SCMCDD ; 9/17/09 4:33pm
- ;;5.3;Scheduling;**204,297,504**;AUG 13, 1993;Build 21
- ;1
- BADNEWDT() ; not a stand alone function!! called from NEWHIST^SCMCDD
- ; ; ensure team/team position is active on DATE
- I FILE=404.59 D I +SCOK=0 Q 1
- . D OKTMTP(IEN,DATE)
- . Q
- ;
- I FILE=404.52 D I +SCOK=0 Q 1
- . D OKTMTP(IEN,DATE)
- . D OKTP(IEN,DATE)
- . ;;bp/cmf if not active, delete newhist entry here?!? [SCHIEN]
- . Q
- ; added **504**
- I FILE=404.53 D I +SCOK=0 Q 1
- . D OKTMTP(IEN,DATE)
- . D OKTP(IEN,DATE)
- . Q
- ;
- Q 0
- ;
- BADCHGDT() ; not a stand alone function!! called from OKCHGDT^SCMCDD
- I FILE=404.59 D I +SCOK=0 Q 1
- . N SCTP
- . S SCTP=$P(SCNODE,U)
- . D OKTMTP(SCTP,DATE)
- . Q
- ;
- I FILE=404.52 D I +SCOK=0 Q 1
- . N SCTP
- . S SCTP=$P(SCNODE,U)
- . D OKTMTP(SCTP,DATE)
- . D OKTP(SCTP,DATE)
- . Q
- ;
- Q 0
- ;
- OKTMTP(SC1,SC2) ;
- ; sc1 := team position ien
- ; sc2 := assignment date
- N SCNODE,SCTM
- S SCNODE=$G(^SCTM(404.57,SC1,0),"BAD")
- I SCNODE="BAD" S SCOK="0^Bad Team Position entry." Q
- S SCTM=$P(SCNODE,U,2)
- S SCNODE=$G(^SCTM(404.51,SCTM,0),"BAD")
- I SCNODE="BAD" S SCOK="0^Bad Team entry." Q
- S SCX=+$$DATES^SCAPMCU1(404.58,SCTM,SC2)
- I SCX<1 S SCOK="0^Team not active on selected date."
- Q
- ;
- OKTP(SC1,SC2) ;
- ; sc1 := team position ien
- ; sc2 := assignment date
- S SCX=+$$DATES^SCAPMCU1(404.59,SC1,SC2)
- I SCX<1 S SCOK="0^Team Position not active on selected date."
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCDDA 1474 printed Mar 13, 2025@21:45:03 Page 2
- SCMCDDA ;bp/cmf - extension of SCMCDD ; 9/17/09 4:33pm
- +1 ;;5.3;Scheduling;**204,297,504**;AUG 13, 1993;Build 21
- +2 ;1
- BADNEWDT() ; not a stand alone function!! called from NEWHIST^SCMCDD
- +1 ; ; ensure team/team position is active on DATE
- +2 IF FILE=404.59
- Begin DoDot:1
- +3 DO OKTMTP(IEN,DATE)
- +4 QUIT
- End DoDot:1
- IF +SCOK=0
- QUIT 1
- +5 ;
- +6 IF FILE=404.52
- Begin DoDot:1
- +7 DO OKTMTP(IEN,DATE)
- +8 DO OKTP(IEN,DATE)
- +9 ;;bp/cmf if not active, delete newhist entry here?!? [SCHIEN]
- +10 QUIT
- End DoDot:1
- IF +SCOK=0
- QUIT 1
- +11 ; added **504**
- +12 IF FILE=404.53
- Begin DoDot:1
- +13 DO OKTMTP(IEN,DATE)
- +14 DO OKTP(IEN,DATE)
- +15 QUIT
- End DoDot:1
- IF +SCOK=0
- QUIT 1
- +16 ;
- +17 QUIT 0
- +18 ;
- BADCHGDT() ; not a stand alone function!! called from OKCHGDT^SCMCDD
- +1 IF FILE=404.59
- Begin DoDot:1
- +2 NEW SCTP
- +3 SET SCTP=$PIECE(SCNODE,U)
- +4 DO OKTMTP(SCTP,DATE)
- +5 QUIT
- End DoDot:1
- IF +SCOK=0
- QUIT 1
- +6 ;
- +7 IF FILE=404.52
- Begin DoDot:1
- +8 NEW SCTP
- +9 SET SCTP=$PIECE(SCNODE,U)
- +10 DO OKTMTP(SCTP,DATE)
- +11 DO OKTP(SCTP,DATE)
- +12 QUIT
- End DoDot:1
- IF +SCOK=0
- QUIT 1
- +13 ;
- +14 QUIT 0
- +15 ;
- OKTMTP(SC1,SC2) ;
- +1 ; sc1 := team position ien
- +2 ; sc2 := assignment date
- +3 NEW SCNODE,SCTM
- +4 SET SCNODE=$GET(^SCTM(404.57,SC1,0),"BAD")
- +5 IF SCNODE="BAD"
- SET SCOK="0^Bad Team Position entry."
- QUIT
- +6 SET SCTM=$PIECE(SCNODE,U,2)
- +7 SET SCNODE=$GET(^SCTM(404.51,SCTM,0),"BAD")
- +8 IF SCNODE="BAD"
- SET SCOK="0^Bad Team entry."
- QUIT
- +9 SET SCX=+$$DATES^SCAPMCU1(404.58,SCTM,SC2)
- +10 IF SCX<1
- SET SCOK="0^Team not active on selected date."
- +11 QUIT
- +12 ;
- OKTP(SC1,SC2) ;
- +1 ; sc1 := team position ien
- +2 ; sc2 := assignment date
- +3 SET SCX=+$$DATES^SCAPMCU1(404.59,SC1,SC2)
- +4 IF SCX<1
- SET SCOK="0^Team Position not active on selected date."
- +5 QUIT
- +6 ;