- SCAPMC19 ;ALB/REW - Team API's ; 12 Jan 99 9:10 AM
- ;;5.3;Scheduling;**41,174**;AUG 13, 1993
- ;;1.0
- ACPRTP(SC200,SCTP,SCFIELDA,SCEFF,SCERR) ; assign practitioner to position
- ; input:
- ; SC200 = New Person File (#200) Pointer
- ; SCTP = Pointer To Team Position File (#404.57)
- ; SCFIELDA= array of extra field entries - scfielda('fld#')=value
- ; -Note: Only used if BRAND NEW POSITION - team fields (404.57)
- ; SCEFF = date to activate/inactivate [default=DT]
- ; SCERR = array NAME to store error messages.
- ; [ex. ^TMP("ORXX",$J)]
- ;
- ; Output:
- ; 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^sctm
- ;
- ;
- N SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS
- N SCPTAIEN,SCESEQ,SCPARM,SCIEN
- G:'$$OKDATA() QT
- S SCSTATUS=$G(@SCFIELDA@(.04))
- 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("POSITION")=$G(SCTP,"Undefined")
- .S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
- .S SCPARM("MESSAGE")="Required Field: #.04 = "_SCSTATUS
- .D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- ;is position already active or will be in future?
- S SCHIST=$P($$ACTHIST^SCAPMCU2(404.52,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("PRACTITIONER")=$G(SC200,"Undefined")
- . S SCPARM("POSITION")=$G(SCTP,"Undefined")
- . S SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
- . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- ;must inactivate same practitioner who was last activated
- S SCOLD200=$P($G(^SCTM(404.52,+$P(SCHIST,U,2),0)),U,3)
- IF ('SCSTATUS)&(SCOLD200&(SCOLD200'=SC200)) D G QT
- . S SCOK=-1
- . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
- . S SCPARM("MESSAGE")="Inactivation must be for same practitioner who was last activated"
- . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- IF (+SCHIST+SCSTATUS)=1!('$D(^SCTM(404.52,"B",SCTP))) D ;procede if not at state now
- .S SC($J,404.52,"+1,",.01)=SCTP
- .S SC($J,404.52,"+1,",.02)=SCEFF
- .S SC($J,404.52,"+1,",.03)=SC200
- .IF $D(SCFIELDA) D
- ..S SCFLD=0
- ..F S SCFLD=$O(@SCFIELDA@(SCFLD)) Q:'SCFLD D
- ...S SC($J,404.52,"+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(^VA(200,+$G(SC200),0)) D
- . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
- . D ERR^SCAPMCU1(.SCESEQ,4045201,.SCPARM,"",.SCERR)
- IF '$D(^SCTM(404.57,+$G(SCTP),0)) D
- . S SCPARM("POSITION")=$G(SCTP,"Undefined")
- . D ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
- F SCFLD=.04,.05 IF '($D(@SCFIELDA@(SCFLD))#2) D
- . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
- . S SCPARM("MESSAGE")="Undefined history fields"
- . D ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- Q SCOK
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCAPMC19 3511 printed Apr 23, 2025@18:52:23 Page 2
- SCAPMC19 ;ALB/REW - Team API's ; 12 Jan 99 9:10 AM
- +1 ;;5.3;Scheduling;**41,174**;AUG 13, 1993
- +2 ;;1.0
- ACPRTP(SC200,SCTP,SCFIELDA,SCEFF,SCERR) ; assign practitioner to position
- +1 ; input:
- +2 ; SC200 = New Person File (#200) Pointer
- +3 ; SCTP = Pointer To Team Position File (#404.57)
- +4 ; SCFIELDA= array of extra field entries - scfielda('fld#')=value
- +5 ; -Note: Only used if BRAND NEW POSITION - team fields (404.57)
- +6 ; SCEFF = date to activate/inactivate [default=DT]
- +7 ; SCERR = array NAME to store error messages.
- +8 ; [ex. ^TMP("ORXX",$J)]
- +9 ;
- +10 ; Output:
- +11 ; SCERR() = Array of DIALOG file messages(errors) .
- +12 ; Foramt:
- +13 ; Subscript: Sequential # from 1 to n
- +14 ; Piece Description
- +15 ; 1 IEN of DIALOG file
- +16 ;
- +17 ; 1 2 3 4 5
- +18 ; Returned: status^histien^actdt^inactdt^sctm
- +19 ;
- +20 ;
- +21 NEW SCTPDTS,SCXX,SCOK,SCHIST,SCACTP,SCSTATUS
- +22 NEW SCPTAIEN,SCESEQ,SCPARM,SCIEN
- +23 if '$$OKDATA()
- GOTO QT
- +24 SET SCSTATUS=$GET(@SCFIELDA@(.04))
- +25 SET SCTPDTS("BEGIN")=SCEFF
- +26 SET SCTPDTS("END")=3990101
- +27 ;for inactive check for any activity in future
- +28 ;for active check for continuous activity in future
- +29 SET SCTPDTS("INCL")='SCSTATUS
- +30 SET SCOK=0
- +31 IF "^1^0^"'[(U_SCSTATUS_U)
- Begin DoDot:1
- +32 SET SCOK=-1
- +33 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
- +34 SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")
- +35 SET SCPARM("MESSAGE")="Required Field: #.04 = "_SCSTATUS
- +36 DO ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO QT
- +37 ;is position already active or will be in future?
- +38 SET SCHIST=$PIECE($$ACTHIST^SCAPMCU2(404.52,SCTP,"SCTPDTS",.SCERR,"SCXX"),U,1,4)
- +39 ;inactivation must be after activation date
- +40 IF ('SCSTATUS)&($PIECE(SCHIST,U,3)'<SCEFF)
- Begin DoDot:1
- +41 SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")
- +42 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
- +43 SET SCPARM("MESSAGE")="Inactivation Date must not be equal to Inactivation Date"
- +44 DO ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO QT
- +45 ;must inactivate same practitioner who was last activated
- +46 SET SCOLD200=$PIECE($GET(^SCTM(404.52,+$PIECE(SCHIST,U,2),0)),U,3)
- +47 IF ('SCSTATUS)&(SCOLD200&(SCOLD200'=SC200))
- Begin DoDot:1
- +48 SET SCOK=-1
- +49 SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")
- +50 SET SCPARM("MESSAGE")="Inactivation must be for same practitioner who was last activated"
- +51 DO ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- End DoDot:1
- GOTO QT
- +52 ;procede if not at state now
- IF (+SCHIST+SCSTATUS)=1!('$DATA(^SCTM(404.52,"B",SCTP)))
- Begin DoDot:1
- +53 SET SC($JOB,404.52,"+1,",.01)=SCTP
- +54 SET SC($JOB,404.52,"+1,",.02)=SCEFF
- +55 SET SC($JOB,404.52,"+1,",.03)=SC200
- +56 IF $DATA(SCFIELDA)
- Begin DoDot:2
- +57 SET SCFLD=0
- +58 FOR
- SET SCFLD=$ORDER(@SCFIELDA@(SCFLD))
- if 'SCFLD
- QUIT
- Begin DoDot:3
- +59 SET SC($JOB,404.52,"+1,",SCFLD)=@SCFIELDA@(SCFLD)
- End DoDot:3
- End DoDot:2
- +60 DO UPDATE^DIE("","SC($J)","SCIEN",.SCERR)
- +61 IF '$GET(@SCERR@(0))<1
- Begin DoDot:2
- End DoDot:2
- +62 if SCSTATUS
- SET SCHIST=SCSTATUS_U_SCIEN(1)_U_SCEFF_U
- +63 if 'SCSTATUS
- SET SCHIST=SCSTATUS_U_SCIEN(1)_U_$PIECE(SCHIST,U,3)_U_SCEFF
- +64 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(^VA(200,+$GET(SC200),0))
- Begin DoDot:1
- +7 SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")
- +8 DO ERR^SCAPMCU1(.SCESEQ,4045201,.SCPARM,"",.SCERR)
- End DoDot:1
- +9 IF '$DATA(^SCTM(404.57,+$GET(SCTP),0))
- Begin DoDot:1
- +10 SET SCPARM("POSITION")=$GET(SCTP,"Undefined")
- +11 DO ERR^SCAPMCU1(.SCESEQ,4045701,.SCPARM,"",.SCERR)
- End DoDot:1
- +12 FOR SCFLD=.04,.05
- IF '($DATA(@SCFIELDA@(SCFLD))#2)
- Begin DoDot:1
- +13 SET SCPARM("PRACTITIONER")=$GET(SC200,"Undefined")
- +14 SET SCPARM("MESSAGE")="Undefined history fields"
- +15 DO ERR^SCAPMCU1(.SCESEQ,4045200,.SCPARM,"",.SCERR)
- End DoDot:1
- +16 QUIT SCOK
