SCAPMC17 ;ALB/REW - Team API's ; 12 Jan 99 9:09 AM
;;5.3;Scheduling;**41,174**;AUG 13, 1993
;;1.0
ACTPNM(SCTPNM,SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- change position status (add if need be)
; input:
; SCTPNM = External Value of Position Name
; SCTMNM = External Value of Team Name
; SCFIELDA = similar to above -used for history entries (404.59)
; SCMAINA = array of extra field entries - scfielda('fld#')=value
; -Note: Only used if BRAND NEW POSITION - team fields (404.57)
; 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^sctp
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 G QTNM
. S SCPARM("TEAM")=$G(SCTM,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
S SCTP=$O(^SCTM(404.57,"APRIMARY",SCTPNM,SCTM,""))
IF 'SCTP D
.S SC($J,404.57,"+1,",.01)=SCTPNM
.S SC($J,404.57,"+1,",.02)=SCTM
.IF $D(SCMAINA) D
..S SCFLD=0
..F S SCFLD=$O(@SCMAINA@(SCFLD)) Q:'SCFLD D
...S SC($J,404.57,"+1,",SCFLD)=@SCMAINA@(SCFLD)
.D UPDATE^DIE("","SC($J)","SCIEN",SCERR)
.I $D(@SCERR) K SCIEN
.S SCTP=$G(SCIEN(1))
S SCACTP=$$ACTP(SCTP,SCFIELDA,SCEFF,SCERR)
QTNM Q SCACTP_U_SCTP
;
ACTP(SCTP,SCFIELDA,SCEFF,SCERR) ; change position status using ien
; input:
; SCTP = Pointer to TEAM POSTION File (#404.57)
; SCFIELDA= array of extra field entries - for history entries (404.59)
; 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
; Returned:status^histien^actdt^inactdt^sctp
;
N SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS,SCTM
N SCPTAIEN,SCESEQ,SCPARM,SCIEN
S SCTM=$P($G(^SCTM(404.57,+$G(SCTP),0)),U,2)
G:'$$OKDATA() QT
S SCSTATUS=$G(@SCFIELDA@(.03))
S SCTPDTS("BEGIN")=SCEFF
S SCTPDTS("END")=3990101
;for inactive check for any activity in future
;for active check for continuous activity in future
S SCTPDTS("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 position already active or will be in future?
S SCHIST=$P($$ACTHIST^SCAPMCU2(404.59,SCTP,"SCTPDTS",.SCERR,"SCXX"),U,1,4)
;inactivation must be after activation date
IF ('SCSTATUS)&($P(SCHIST,U,3)'<SCEFF) D G QT
. S SCPARM("POSITION")=$G(SCTP,"Undefined")
. S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
. D ERR^SCAPMCU1(.SCESEQ,4045700,.SCPARM,"",.SCERR)
IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.59,"B",SCTP))) D ;procede if not at state now
.S SC($J,404.59,"+1,",.01)=SCTP
.S SC($J,404.59,"+1,",.02)=SCEFF
.IF $D(SCFIELDA) D
..S SCFLD=0
..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
...S SC($J,404.59,"+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 acTP call
N SCOK,SCFLD
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
S:'$G(SCEFF) SCEFF=DT
IF '$D(^SCTM(404.57,+$G(SCTP),0)) D
. S SCPARM("POSITION")=$G(SCTP,"Undefined")
. D ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
F SCFLD=.03,.04 IF '($D(@SCFIELDA@(SCFLD))#2) D
. S SCPARM("TEAM")=$G(SCTM,"Undefined")
. S SCPARM("MESSAGE")="Undefined history fields"
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
Q SCOK
OKNMDATA() ;
;setup/check variables for acTPnm call
N SCOK,SCFLD
S SCOK=1
D INIT^SCAPMCU1(.SCOK)
S:'$G(SCEFF) SCEFF=DT
; only check 404.57 fields if no entry already
IF '$D(^SCTM(404.57,"B",SCTPNM)) D
.F SCFLD=.03 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")
. S SCPARM("MESSAGE")="Required Field: #"_SCFLD
. D ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
Q SCOK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC17 5099 printed Nov 22, 2024@17:47:49 Page 2
SCAPMC17 ;ALB/REW - Team API's ; 12 Jan 99 9:09 AM
+1 ;;5.3;Scheduling;**41,174**;AUG 13, 1993
+2 ;;1.0
ACTPNM(SCTPNM,SCTMNM,SCFIELDA,SCMAINA,SCEFF,SCERR) ; -- change position status (add if need be)
+1 ; input:
+2 ; SCTPNM = External Value of Position Name
+3 ; SCTMNM = External Value of Team Name
+4 ; SCFIELDA = similar to above -used for history entries (404.59)
+5 ; SCMAINA = array of extra field entries - scfielda('fld#')=value
+6 ; -Note: Only used if BRAND NEW POSITION - team fields (404.57)
+7 ; SCEFF = date to activate [default=DT]
+8 ; SCERR = array NAME to store error messages.
+9 ; [ex. ^TMP("ORXX",$J)]
+10 ;
+11 ; Output:
+12 ; SCPTAIEN = ien if entry made to file 404.43, 0 ow
+13 ; SCERR() = Array of DIALOG file messages(errors) .
+14 ; Foramt:
+15 ; Subscript: Sequential # from 1 to n
+16 ; Piece Description
+17 ; 1 IEN of DIALOG file
+18 ;
+19 ; 1 2 3 4 5 6
+20 ; Returned: Ok?^status^histien^actdt^inactdt^sctp
+21 NEW SCTM,SC,SCFLD,SCACTM
+22 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
+23 SET SCACTM=-1
+24 ;does entry exist? if not create
+25 ;check/setup variables
if '$$OKNMDATA
GOTO QTNM
+26 SET SCTM=$ORDER(^SCTM(404.51,"B",SCTMNM,""))
+27 IF 'SCTM
Begin DoDot:1
+28 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+29 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
GOTO QTNM
+30 SET SCTP=$ORDER(^SCTM(404.57,"APRIMARY",SCTPNM,SCTM,""))
+31 IF 'SCTP
Begin DoDot:1
+32 SET SC($JOB,404.57,"+1,",.01)=SCTPNM
+33 SET SC($JOB,404.57,"+1,",.02)=SCTM
+34 IF $DATA(SCMAINA)
Begin DoDot:2
+35 SET SCFLD=0
+36 FOR
SET SCFLD=$ORDER(@SCMAINA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+37 SET SC($JOB,404.57,"+1,",SCFLD)=@SCMAINA@(SCFLD)
End DoDot:3
End DoDot:2
+38 DO UPDATE^DIE("","SC($J)","SCIEN",SCERR)
+39 IF $DATA(@SCERR)
KILL SCIEN
+40 SET SCTP=$GET(SCIEN(1))
End DoDot:1
+41 SET SCACTP=$$ACTP(SCTP,SCFIELDA,SCEFF,SCERR)
QTNM QUIT SCACTP_U_SCTP
+1 ;
ACTP(SCTP,SCFIELDA,SCEFF,SCERR) ; change position status using ien
+1 ; input:
+2 ; SCTP = Pointer to TEAM POSTION File (#404.57)
+3 ; SCFIELDA= array of extra field entries - for history entries (404.59)
+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 ;
+16 ; 1 2 3 4 5
+17 ; Returned:status^histien^actdt^inactdt^sctp
+18 ;
+19 NEW SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS,SCTM
+20 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
+21 SET SCTM=$PIECE($GET(^SCTM(404.57,+$GET(SCTP),0)),U,2)
+22 if '$$OKDATA()
GOTO QT
+23 SET SCSTATUS=$GET(@SCFIELDA@(.03))
+24 SET SCTPDTS("BEGIN")=SCEFF
+25 SET SCTPDTS("END")=3990101
+26 ;for inactive check for any activity in future
+27 ;for active check for continuous activity in future
+28 SET SCTPDTS("INCL")='SCSTATUS
+29 SET SCOK=0
+30 IF "^1^0^"'[(U_SCSTATUS_U)
Begin DoDot:1
+31 SET SCOK=-1
+32 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+33 SET SCPARM("MESSAGE")="Required Field: #.03"_SCSTATUS
+34 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
GOTO QT
+35 ;is position already active or will be in future?
+36 SET SCHIST=$PIECE($$ACTHIST^SCAPMCU2(404.59,SCTP,"SCTPDTS",.SCERR,"SCXX"),U,1,4)
+37 ;inactivation must be after activation date
+38 IF ('SCSTATUS)&($PIECE(SCHIST,U,3)'<SCEFF)
Begin DoDot:1
+39 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
+40 SET SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
+41 DO ERR^SCAPMCU1(.SCESEQ,4045700,.SCPARM,"",.SCERR)
End DoDot:1
GOTO QT
+42 ;procede if not at state now
IF (+SCHIST+SCSTATUS)=1!('$DATA(^SCTM(404.59,"B",SCTP)))
Begin DoDot:1
+43 SET SC($JOB,404.59,"+1,",.01)=SCTP
+44 SET SC($JOB,404.59,"+1,",.02)=SCEFF
+45 IF $DATA(SCFIELDA)
Begin DoDot:2
+46 SET SCFLD=0
+47 FOR
SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
if 'SCFLD
QUIT
Begin DoDot:3
+48 SET SC($JOB,404.59,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
End DoDot:3
End DoDot:2
+49 DO UPDATE^DIE("","SC($J)","SCIEN","SCERR")
+50 IF '$GET(@SCERR@(0))<1
Begin DoDot:2
End DoDot:2
+51 if SCSTATUS
SET SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
+52 if 'SCSTATUS
SET SCHIST=SCSTATUS_U_SCIEN(1)_U_$PIECE(SCHIST,U,3)_U_SCEFF
+53 SET SCOK=1
End DoDot:1
QT QUIT SCOK_U_$GET(SCHIST)
+1 ;
OKDATA() ;
+1 ;setup/check variables for acTP call
+2 NEW SCOK,SCFLD
+3 SET SCOK=1
+4 DO INIT^SCAPMCU1(.SCOK)
+5 if '$GET(SCEFF)
SET SCEFF=DT
+6 IF '$DATA(^SCTM(404.57,+$GET(SCTP),0))
Begin DoDot:1
+7 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
+8 DO ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
End DoDot:1
+9 FOR SCFLD=.03,.04
IF '($DATA(@SCFIELDA@(SCFLD))#2)
Begin DoDot:1
+10 SET SCPARM("TEAM")=$GET(SCTM,"Undefined")
+11 SET SCPARM("MESSAGE")="Undefined history fields"
+12 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
+13 QUIT SCOK
OKNMDATA() ;
+1 ;setup/check variables for acTPnm 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.57 fields if no entry already
+7 IF '$DATA(^SCTM(404.57,"B",SCTPNM))
Begin DoDot:1
+8 FOR SCFLD=.03
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 SET SCPARM("MESSAGE")="Required Field: #"_SCFLD
+15 DO ERR^SCAPMCU1(.SCESEQ,4045100,.SCPARM,"",.SCERR)
End DoDot:1
+16 QUIT SCOK
