SCMCBK4.m

SCMCBK4 ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1; AUG 5, 1998

 ;;5.3;Scheduling;**148,157**;AUG 13, 1993

 Q

 ;

 ;

QUEUED(SCX) ;if XWBAPVER=1

 ;       ;SCX=1: called from ptfile^scmcbk

 ;       ;SCX=2: called from posfile^scmcbk

 ;

 S SCOK("Result")=0

 S SC("DUZ")=DUZ

 S ZTDTH=$H

 S SCX=$$S(SCX)

 S ZTRTN=$P(SCX,"::")

 S ZTDESC=$P(SCX,"::",2)

 S ZTSAVE("SC(")=""

 ;;;S ZTSAVE("^TMP("_SC("JOB")_",")=""

 S ZTSAVE("^TMP($J,")=""

 D ^%ZTLOAD

 I $D(ZTSK) S SCOK("Result")=1

 D EXIT1^SCRPTM

 ;;;K SCX,^TMP(SC("JOB"))

 K SCX,^TMP($J)

 Q

 ;

QMPTTM ; process patient team assignments

 N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR

 ;

 D SETUP

 ;

 S SCADDFLD(.08)=$G(SC("TYPE"),99)

 S SCADDFLD(.1)=$G(SC("RESTRICT"),0)

 S SCADDFLD(.11)=$G(SC("DUZ"),.5)

 S SCADDFLD(.12)=DT

 ;

 ;       ;like $$ACPTATM^SCAPMC6(...

 ;;;S SCX=$$ACPTATM^SCMCBK5("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")

 S SCX=$$ACPTATM^SCMCBK5("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")

 ;

 D CLEANUP

FILEQ Q

 ;

 ;

QMPTPO ;process patient position assignments

 N SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG

 N SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1

 ;

 D SETUP

 S SCADTM=1

 ;

 S SCADDFLD(.05)=$G(SC("TYPE"),0)

 S SCADDFLD(.06)=$G(SC("DUZ"),.5)

 S SCADDFLD(.07)=DT

 ;

 ;       ;like $$ACPTATP^SCAPMC21(...

 ;;;S SCX=$$ACPTATP^SCMCBK8("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")

 S SCX=$$ACPTATP^SCMCBK8("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")

 ;

 D CLEANUP

 Q

 ;

SETUP D CHK^SCUTBK

 D TMP^SCUTBK

 D PARSE^SCMCBK1(.SC)

 S SCMAIL1=$G(SC("DUZ"),.5)

 S SCJOB=$J

 ;;;G:+$G(SCJOB)=0 FILEQ

 Q

 ;

CLEANUP ;;;K ^TMP(SCJOB,"SC PATIENT LIST")

 K ^TMP($J,"SC PATIENT LIST")

 D CLRVAR^SCMCBK1

 Q

 ;

S(SCX) ;return text string

 Q $P($T(T+SCX),";;",2)

 ;

T ;;

 ;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment

 ;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCMCBK4   2203     printed  Apr 23, 2025@18:54:21                                                                                                                                                                                                     Page 2

SCMCBK4   ;bp/cmf - multiple patient assignments mail queue - RPCVersion = 1; AUG 5, 1998

 +1       ;;5.3;Scheduling;**148,157**;AUG 13, 1993

 +2        QUIT 

 +3       ;

 +4       ;

QUEUED(SCX) ;if XWBAPVER=1

 +1       ;       ;SCX=1: called from ptfile^scmcbk

 +2       ;       ;SCX=2: called from posfile^scmcbk

 +3       ;

 +4        SET SCOK("Result")=0

 +5        SET SC("DUZ")=DUZ

 +6        SET ZTDTH=$HOROLOG

 +7        SET SCX=$$S(SCX)

 +8        SET ZTRTN=$PIECE(SCX,"::")

 +9        SET ZTDESC=$PIECE(SCX,"::",2)

 +10       SET ZTSAVE("SC(")=""

 +11      ;;;S ZTSAVE("^TMP("_SC("JOB")_",")=""

 +12       SET ZTSAVE("^TMP($J,")=""

 +13       DO ^%ZTLOAD

 +14       IF $DATA(ZTSK)

               SET SCOK("Result")=1

 +15       DO EXIT1^SCRPTM

 +16      ;;;K SCX,^TMP(SC("JOB"))

 +17       KILL SCX,^TMP($JOB)

 +18       QUIT 

 +19      ;

QMPTTM    ; process patient team assignments

 +1        NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG,SCX,SCDTVAR

 +2       ;

 +3        DO SETUP

 +4       ;

 +5        SET SCADDFLD(.08)=$GET(SC("TYPE"),99)

 +6        SET SCADDFLD(.1)=$GET(SC("RESTRICT"),0)

 +7        SET SCADDFLD(.11)=$GET(SC("DUZ"),.5)

 +8        SET SCADDFLD(.12)=DT

 +9       ;

 +10      ;       ;like $$ACPTATM^SCAPMC6(...

 +11      ;;;S SCX=$$ACPTATM^SCMCBK5("^TMP(SCJOB,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")

 +12       SET SCX=$$ACPTATM^SCMCBK5("^TMP($J,""SC PATIENT LIST"")",SCTEAM,"SCADDFLD",SCDTVAR,"SCERMSG","SCNEW","SCOLD","SCBAD")

 +13      ;

 +14       DO CLEANUP

FILEQ      QUIT 

 +1       ;

 +2       ;

QMPTPO    ;process patient position assignments

 +1        NEW SCADDFLD,SCTEAM,SCFILE,SCJOB,SCNEW,SCOLD,SCBAD,SCERMSG

 +2        NEW SCX,SCPOS,SCDTVAR,SCMAFLD,SCADTM,SCNEW1

 +3       ;

 +4        DO SETUP

 +5        SET SCADTM=1

 +6       ;

 +7        SET SCADDFLD(.05)=$GET(SC("TYPE"),0)

 +8        SET SCADDFLD(.06)=$GET(SC("DUZ"),.5)

 +9        SET SCADDFLD(.07)=DT

 +10      ;

 +11      ;       ;like $$ACPTATP^SCAPMC21(...

 +12      ;;;S SCX=$$ACPTATP^SCMCBK8("^TMP(SCJOB,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")

 +13       SET SCX=$$ACPTATP^SCMCBK8("^TMP($J,""SC PATIENT LIST"")",SCPOS,"SCADDFLD",SCDTVAR,"SCERMSG",SCADTM,"","SCNEW","SCNEW1","SCOLD","SCBAD")

 +14      ;

 +15       DO CLEANUP

 +16       QUIT 

 +17      ;

SETUP      DO CHK^SCUTBK

 +1        DO TMP^SCUTBK

 +2        DO PARSE^SCMCBK1(.SC)

 +3        SET SCMAIL1=$GET(SC("DUZ"),.5)

 +4        SET SCJOB=$JOB

 +5       ;;;G:+$G(SCJOB)=0 FILEQ

 +6        QUIT 

 +7       ;

CLEANUP   ;;;K ^TMP(SCJOB,"SC PATIENT LIST")

 +1        KILL ^TMP($JOB,"SC PATIENT LIST")

 +2        DO CLRVAR^SCMCBK1

 +3        QUIT 

 +4       ;

S(SCX)    ;return text string

 +1        QUIT $PIECE($TEXT(T+SCX),";;",2)

 +2       ;

T         ;;

 +1       ;;QMPTTM^SCMCBK4::PCMM Multiple Patient Team Assignment

 +2       ;;QMPTPO^SCMCBK4::PCMM Multiple Patient Position Assignment

 +3       ;