- SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
- ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- ;;1.0
- ACTMNM(SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- activate a team (add if need be)
- ; input:
- ; SCTMNM = External Value of Team Name
- ; SCFIELDA= similar to above -used for history entries (404.58)
- ; SCMAINA = array of extra field entries - scfielda('fld#')=value
- ; -Note: Only used if BRAND NEW TEAM - team fields (404.51)
- ; SCEFF = date to activate [default=DT]
- ; SCERR = array NAME to store error messages.
- ; [ex. ^TMP("ORXX",$J)]
- ;
- ; Output:
- ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
- ; SCERR() = Array of DIALOG file messages(errors) .
- ; Foramt:
- ; Subscript: Sequential # from 1 to n
- ; Piece Description
- ; 1 IEN of DIALOG file
- ;
- ; 1 2 3 4 5 6
- ; Returned: Ok?^status^histien^actdt^inactdt^sctm
- N SCTM,SC,SCFLD,SCACTM
- N SCPTAIEN,SCESEQ,SCPARM,SCIEN
- S SCACTM=-1
- ;does entry exist? if not create
- G:'$$OKNMDATA QTNM ;check/setup variables
- S SCTM=$O(^SCTM(404.51,"B",SCTMNM,""))
- IF 'SCTM D
- .S SC($J,404.51,"+1,",.01)=SCTMNM
- .IF $D(SCMAINA) D
- ..S SCFLD=0
- ..F S SCFLD=$O(@SCMAINA@(SCFLD)) Q:'SCFLD D
- ...S SC($J,404.51,"+1,",SCFLD)=@SCMAINA@(SCFLD)
- .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
- .I $D(@SCERR) K SCIEN
- .S SCTM=$G(SCIEN(1))
- S SCACTM=$$ACTM(SCTM,SCFIELDA,SCEFF,SCERR)
- QTNM Q SCACTM_U_SCTM
- ;
- ACTM(SCTM,SCFIELDA,SCEFF,SCERR) ; activate team from internal entry#
- ; input:
- ; SCTM = Pointer to Team File (#404.51)
- ; SCFIELDA= array of extra field entries for history entries (404.58)
- ; SCEFF = date to activate [default=DT]
- ; SCERR = array NAME to store error messages.
- ; [ex. ^TMP("ORXX",$J)]
- ;
- ; Output:
- ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
- ; SCERR() = Array of DIALOG file messages(errors) .
- ; Foramt:
- ; Subscript: Sequential # from 1 to n
- ; Piece Description
- ; 1 IEN of DIALOG file
- ; 1 2 3 4
- ; Returned: status^history ien^actdt^inactdt
- ;
- N SCTMDTS,SCXX,SCOK,SCHIST,SCACTM,SCSTATUS
- N SCPTAIEN,SCESEQ,SCPARM,SCIEN
- G:'$$OKDATA() QT
- S SCSTATUS=$G(@SCFIELDA@(.03))
- S SCTMDTS("BEGIN")=SCEFF
- S SCTMDTS("END")=3990101
- ;for inactive check for any activity in future
- ;for active check for continuous activity in future
- S SCTMDTS("INCL")='SCSTATUS
- S SCOK=0
- IF "^1^0^"'[(U_SCSTATUS_U) D G QT
- .S SCOK=-1
- .S SCPARM("TEAM")=$G(SCTM,"Undefined")
- .S SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
- .D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- ;is team already active or will be in future?
- S SCHIST=$P($$ACTHIST^SCAPMCU2(404.58,SCTM,"SCTMDTS",.SCERR,"SCXX"),U,1,4)
- IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D G QT
- . S SCPARM("TEAM")=$G(SCTM,"Undefined")
- . S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
- . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.58,"B",SCTM))) D ;procede if not at state now
- .S SC($J,404.58,"+1,",.01)=SCTM
- .S SC($J,404.58,"+1,",.02)=SCEFF
- .IF $D(SCFIELDA) D
- ..S SCFLD=0
- ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
- ...S SC($J,404.58,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
- .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
- .IF '$G(@SCERR@(0))<1 D
- .S:SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
- .S:'SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_$P(SCHIST,U,3)_U_SCEFF
- .S SCOK=1
- QT Q SCOK_U_$G(SCHIST)
- ;
- OKDATA() ;
- ;setup/check variables for actm call
- N SCOK,SCFLD
- S SCOK=1
- D INIT^SCAPMCU1(.SCOK)
- S:'$G(SCEFF) SCEFF=DT
- F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
- . S SCPARM("TEAM")=$G(SCTM,"Undefined")
- . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- Q SCOK
- OKNMDATA() ;
- ;setup/check variables for actmnm call
- N SCOK,SCFLD
- S SCOK=1
- D INIT^SCAPMCU1(.SCOK)
- S:'$G(SCEFF) SCEFF=DT
- ; only check 404.51 fields if no entry already
- IF '$D(^SCTM(404.51,"B",SCTMNM)) D
- .F SCFLD=.03,.06,.07 IF '($D(@SCMAINA@(SCFLD))#2) D
- ..S SCPARM("TEAM")=$G(SCTM,"Undefined")
- ..S SCPARM("MESSAGE")="Required Field: #"_SCFLD
- ..D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
- . S SCPARM("TEAM")=$G(SCTM,"Undefined")
- . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- Q SCOK
- SCAPMC15 ;ALB/REW - Team API's ; December 1, 1995
- +1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- +2 ;;1.0
- ACTMNM(SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- activate a team (add if need be)
- +1 ; input:
- +2 ; SCTMNM = External Value of Team Name
- +3 ; SCFIELDA= similar to above -used for history entries (404.58)
- +4 ; SCMAINA = array of extra field entries - scfielda('fld#')=value
- +5 ; -Note: Only used if BRAND NEW TEAM - team fields (404.51)
- +6 ; SCEFF = date to activate [default=DT]
- +7 ; SCERR = array NAME to store error messages.
- +8 ; [ex. ^TMP("ORXX",$J)]
- +9 ;
- +10 ; Output:
- +11 ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
- +12 ; SCERR() = Array of DIALOG file messages(errors) .
- +13 ; Foramt:
- +14 ; Subscript: Sequential # from 1 to n
- +15 ; Piece Description
- +16 ; 1 IEN of DIALOG file
- +17 ;
- +18 ; 1 2 3 4 5 6
- +19 ; Returned: Ok?^status^histien^actdt^inactdt^sctm
- +20 NEW SCTM,SC,SCFLD,SCACTM
- +21 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
- +22 SET SCACTM=-1
- +23 ;does entry exist? if not create
- +24 ;check/setup variables
- IF '$$OKNMDATA
- GOTO QTNM
- +25 SET SCTM=$ORDER(^SCTM(404.51,"B",SCTMNM,""))
- +26 IF 'SCTM
- Begin DoDot:1
- +27 SET SC($JOB,404.51,"+1,",.01)=SCTMNM
- +28 IF $DATA(SCMAINA)
- Begin DoDot:2
- +29 SET SCFLD=0
- +30 FOR
- SET SCFLD=$ORDER(@SCMAINA@(SCFLD))
- IF 'SCFLD
- QUIT
- Begin DoDot:3
- +31 SET SC($JOB,404.51,"+1,",SCFLD)=@SCMAINA@(SCFLD)
- End DoDot:3
- End DoDot:2
- +32 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
- +33 IF $DATA(@SCERR)
- KILL SCIEN
- +34 SET SCTM=$GET(SCIEN(1))
- End DoDot:1
- +35 SET SCACTM=$$ACTM(SCTM,SCFIELDA,SCEFF,SCERR)
- QTNM QUIT SCACTM_U_SCTM
- +1 ;
- ACTM(SCTM,SCFIELDA,SCEFF,SCERR) ; activate team from internal entry#
- +1 ; input:
- +2 ; SCTM = Pointer to Team File (#404.51)
- +3 ; SCFIELDA= array of extra field entries for history entries (404.58)
- +4 ; SCEFF = date to activate [default=DT]
- +5 ; SCERR = array NAME to store error messages.
- +6 ; [ex. ^TMP("ORXX",$J)]
- +7 ;
- +8 ; Output:
- +9 ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
- +10 ; SCERR() = Array of DIALOG file messages(errors) .
- +11 ; Foramt:
- +12 ; Subscript: Sequential # from 1 to n
- +13 ; Piece Description
- +14 ; 1 IEN of DIALOG file
- +15 ; 1 2 3 4
- +16 ; Returned: status^history ien^actdt^inactdt
- +17 ;
- +18 NEW SCTMDTS,SCXX,SCOK,SCHIST,SCACTM,SCSTATUS
- +19 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
- +20 IF '$$OKDATA()
- GOTO QT
- +21 SET SCSTATUS=$GET(@SCFIELDA@(.03))
- +22 SET SCTMDTS("BEGIN")=SCEFF
- +23 SET SCTMDTS("END")=3990101
- +24 ;for inactive check for any activity in future
- +25 ;for active check for continuous activity in future
- +26 SET SCTMDTS("INCL")='SCSTATUS
- +27 SET SCOK=0
- +28 IF "^1^0^"'[(U_SCSTATUS_U)
- Begin DoDot:1
- +29 SET SCOK=-1
- +30 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
- +31 SET SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
- +32 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO QT
- +33 ;is team already active or will be in future?
- +34 SET SCHIST=$PIECE($$ACTHIST^SCAPMCU2(404.58,SCTM,"SCTMDTS",.SCERR,"SCXX"),U,1,4)
- +35 IF ('SCSTATUS)&($PIECE(SCHIST,U,3)'<SCEFF)
- Begin DoDot:1
- +36 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
- +37 SET SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
- +38 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO QT
- +39 ;procede if not at state now
- IF (+SCHIST+SCSTATUS)=1!('$DATA(^SCTM(404.58,"B",SCTM)))
- Begin DoDot:1
- +40 SET SC($JOB,404.58,"+1,",.01)=SCTM
- +41 SET SC($JOB,404.58,"+1,",.02)=SCEFF
- +42 IF $DATA(SCFIELDA)
- Begin DoDot:2
- +43 SET SCFLD=0
- +44 FOR
- SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
- IF 'SCFLD
- QUIT
- Begin DoDot:3
- +45 SET SC($JOB,404.58,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
- End DoDot:3
- End DoDot:2
- +46 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
- +47 IF '$GET(@SCERR@(0))<1
- Begin DoDot:2
- End DoDot:2
- +48 IF SCSTATUS
- SET SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
- +49 IF 'SCSTATUS
- SET SCHIST=SCSTATUS_U_SCIEN(1)_U_$PIECE(SCHIST,U,3)_U_SCEFF
- +50 SET SCOK=1
- End DoDot:1
- QT QUIT SCOK_U_$GET(SCHIST)
- +1 ;
- OKDATA() ;
- +1 ;setup/check variables for actm call
- +2 NEW SCOK,SCFLD
- +3 SET SCOK=1
- +4 DO INIT^SCAPMCU1(.SCOK)
- +5 IF '$GET(SCEFF)
- SET SCEFF=DT
- +6 FOR SCFLD=.03,.04
- IF '($DATA(@SCFIELDA@(SCFLD))#2)
- Begin DoDot:1
- +7 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
- +8 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- End DoDot:1
- +9 QUIT SCOK
- OKNMDATA() ;
- +1 ;setup/check variables for actmnm call
- +2 NEW SCOK,SCFLD
- +3 SET SCOK=1
- +4 DO INIT^SCAPMCU1(.SCOK)
- +5 IF '$GET(SCEFF)
- SET SCEFF=DT
- +6 ; only check 404.51 fields if no entry already
- +7 IF '$DATA(^SCTM(404.51,"B",SCTMNM))
- Begin DoDot:1
- +8 FOR SCFLD=.03,.06,.07
- IF '($DATA(@SCMAINA@(SCFLD))#2)
- Begin DoDot:2
- +9 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
- +10 SET SCPARM("MESSAGE")="Required Field: #"_SCFLD
- +11 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- End DoDot:2
- End DoDot:1
- +12 FOR SCFLD=.03,.04
- IF '($DATA(@SCFIELDA@(SCFLD))#2)
- Begin DoDot:1
- +13 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
- +14 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
- End DoDot:1
- +15 QUIT SCOK
