Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCAPMC17

SCAPMC17.m

Go to the documentation of this file. 
  1. SCAPMC17 ;ALB/REW - Team API's ; 12 Jan 99  9:09 AM
  1.  ;;5.3;Scheduling;**41,174**;AUG 13, 1993
  1.  ;;1.0
  1. ACTPNM(SCTPNM,SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- change position status (add if need be)
  1.  ; input:
  1.  ;  SCTPNM  = External Value of Position Name
  1.  ;  SCTMNM  = External Value of Team Name
  1.  ;  SCFIELDA = similar to above -used for history entries (404.59)
  1.  ;  SCMAINA = array of extra field entries - scfielda('fld#')=value
  1.  ;     -Note: Only used if BRAND NEW POSITION - team fields (404.57)
  1.  ;  SCEFF   = date to activate [default=DT]
  1.  ;  SCERR = array NAME to store error messages.
  1.  ;          [ex. ^TMP("ORXX",$J)]
  1.  ;
  1.  ; Output:
  1.  ;  SCPTAIEN    = ien if entry made to file 404.43, 0 ow
  1.  ;  SCERR() = Array of DIALOG file messages(errors) .
  1.  ;             Foramt:
  1.  ;               Subscript: Sequential # from 1 to n
  1.  ;               Piece     Description
  1.  ;                 1       IEN of DIALOG file
  1.  ;
  1.  ;            1      2      3      4      5      6
  1.  ;  Returned: Ok?^status^histien^actdt^inactdt^sctp
  1.  N SCTM,SC,SCFLD,SCACTM
  1.  N SCPTAIEN,SCESEQ,SCPARM,SCIEN
  1.  S SCACTM=-1
  1.  ;does entry exist? if not create
  1.  G:'$$OKNMDATA QTNM ;check/setup variables
  1.  S SCTM=$O(^SCTM(404.51,"B",SCTMNM,""))
  1.  IF 'SCTM D  G QTNM
  1.  . S SCPARM("TEAM")=$G(SCTM,"Undefined")
  1.  . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
  1.  S SCTP=$O(^SCTM(404.57,"APRIMARY",SCTPNM,SCTM,""))
  1.  IF 'SCTP D
  1.  .S SC($J,404.57,"+1,",.01)=SCTPNM
  1.  .S SC($J,404.57,"+1,",.02)=SCTM
  1.  .IF $D(SCMAINA) D
  1.  ..S SCFLD=0
  1.  ..F  S SCFLD=$O(@SCMAINA@(SCFLD)) Q:'SCFLD  D
  1.  ...S SC($J,404.57,"+1,",SCFLD)=@SCMAINA@(SCFLD)
  1.  .D UPDATE^DIE("","SC($J)","SCIEN",SCERR)
  1.  .I $D(@SCERR) K SCIEN
  1.  .S SCTP=$G(SCIEN(1))
  1.  S SCACTP=$$ACTP(SCTP,SCFIELDA,SCEFF,SCERR)
  1. QTNM Q SCACTP_U_SCTP
  1.  ;
  1. ACTP(SCTP,SCFIELDA,SCEFF,SCERR) ; change position status using ien
  1.  ; input:
  1.  ;  SCTP  = Pointer to TEAM POSTION File (#404.57)
  1.  ;  SCFIELDA= array of extra field entries - for history entries (404.59)
  1.  ;  SCEFF   = date to activate [default=DT]
  1.  ;  SCERR = array NAME to store error messages.
  1.  ;          [ex. ^TMP("ORXX",$J)]
  1.  ;
  1.  ; Output:
  1.  ;  SCPTAIEN    = ien if entry made to file 404.43, 0 ow
  1.  ;  SCERR() = Array of DIALOG file messages(errors) .
  1.  ;             Foramt:
  1.  ;               Subscript: Sequential # from 1 to n
  1.  ;               Piece     Description
  1.  ;                 1       IEN of DIALOG file
  1.  ;
  1.  ;            1      2      3      4      5
  1.  ;  Returned:status^histien^actdt^inactdt^sctp
  1.  ;
  1.  N SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS,SCTM
  1.  N SCPTAIEN,SCESEQ,SCPARM,SCIEN
  1.  S SCTM=$P($G(^SCTM(404.57,+$G(SCTP),0)),U,2)
  1.  G:'$$OKDATA() QT
  1.  S SCSTATUS=$G(@SCFIELDA@(.03))
  1.  S SCTPDTS("BEGIN")=SCEFF
  1.  S SCTPDTS("END")=3990101
  1.  ;for inactive check for any activity in future
  1.  ;for active check for continuous activity in future
  1.  S SCTPDTS("INCL")='SCSTATUS
  1.  S SCOK=0
  1.  IF "^1^0^"'[(U_SCSTATUS_U) D  G QT
  1.  .S SCOK=-1
  1.  .S SCPARM("TEAM")=$G(SCTM,"Undefined")
  1.  .S SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
  1.  .D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
  1.  ;is position already active or will be in future?
  1.  S SCHIST=$P($$ACTHIST^SCAPMCU2(404.59,SCTP,"SCTPDTS",.SCERR,"SCXX"),U,1,4)
  1.  ;inactivation must be after activation date
  1.  IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D  G QT
  1.  . S SCPARM("POSITION")=$G(SCTP,"Undefined")
  1.  . S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
  1.  . D ERR^SCAPMCU1(.SCESEQ,4045700,.SCPARM,"",.SCERR)
  1.  IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.59,"B",SCTP))) D  ;procede if not at state now
  1.  .S SC($J,404.59,"+1,",.01)=SCTP
  1.  .S SC($J,404.59,"+1,",.02)=SCEFF
  1.  .IF $D(SCFIELDA) D
  1.  ..S SCFLD=0
  1.  ..F  S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD  D
  1.  ...S SC($J,404.59,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
  1.  .D UPDATE^DIE("","SC($J)","SCIEN","SCERR")
  1.  .IF '$G(@SCERR@(0))<1 D
  1.  .S:SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
  1.  .S:'SCSTATUS SCHIST=SCSTATUS_U_SCIEN(1)_U_$P(SCHIST,U,3)_U_SCEFF
  1.  .S SCOK=1
  1. QT Q SCOK_U_$G(SCHIST)
  1.  ;
  1. OKDATA() ;
  1.  ;setup/check variables for acTP call
  1.  N SCOK,SCFLD
  1.  S SCOK=1
  1.  D INIT^SCAPMCU1(.SCOK)
  1.  S:'$G(SCEFF) SCEFF=DT
  1.  IF '$D(^SCTM(404.57,+$G(SCTP),0)) D
  1.  . S SCPARM("POSITION")=$G(SCTP,"Undefined")
  1.  . D ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
  1.  F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
  1.  . S SCPARM("TEAM")=$G(SCTM,"Undefined")
  1.  . S SCPARM("MESSAGE")="Undefined history fields"
  1.  . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
  1.  Q SCOK
  1. OKNMDATA() ;
  1.  ;setup/check variables for acTPnm call
  1.  N SCOK,SCFLD
  1.  S SCOK=1
  1.  D INIT^SCAPMCU1(.SCOK)
  1.  S:'$G(SCEFF) SCEFF=DT
  1.  ; only check 404.57 fields if no entry already
  1.  IF '$D(^SCTM(404.57,"B",SCTPNM)) D
  1.  .F SCFLD=.03 IF '($D(@SCMAINA@(SCFLD))#2) D
  1.  ..S SCPARM("TEAM")=$G(SCTM,"Undefined")
  1.  ..S SCPARM("MESSAGE")="Required Field: #"_SCFLD
  1.  ..D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
  1.  F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
  1.  . S SCPARM("TEAM")=$G(SCTM,"Undefined")
  1.  . S SCPARM("MESSAGE")="Required Field: #"_SCFLD
  1.  . D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
  1.  Q SCOK