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

SCMCTSK9.m

Go to the documentation of this file. 
  1. SCMCTSK9 ;;BP/DMR - PCMM ; 18 Apr 2003  9:36 AM
  1.  ;;5.3;Scheduling;**297,526,1015**;AUG 13, 1993;Build 21
  1.  Q
  1. EXTKEY ;
  1.  N Y,% W @IOF,!,$G(SCDHD) D NOW^%DTC S Y=% W:$X>(IOM-40) ! W ?(IOM-40)
  1.  W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 "  "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12)
  1.  W ?(IOM-15),"PAGE: "_($G(DC)+1)
  1.  S Y="",$P(Y,"-",IOM)="" W !,Y,!!
  1.  W !,"Column Heading        Explanation of column headings"
  1.  W !
  1.  W !,"Patient Name          Name of patient scheduled to be inactivated from their primary care team and position/provider."
  1.  W !,"SSN                   SSN number."
  1.  W !,"Institution           Institution name, previously called Division, in which patient receives primary care."
  1.  W !,"PC Team               The patient's assigned Primary Care team in PCMM."
  1.  W !,"Provider/             Name of Associate Primary Care Provider (AP) assigned to patient, if there is one."
  1.  W !," Team Position        The name of the team position to which the Associate Primary Care Provider (AP) is assigned."
  1.  W !,"Current Preceptor/    Name of Primary Care Provider (PCP) assigned to patient.  Every Primary Care patient should"
  1.  W !," Team Position        be assigned to one PCP. The name of the team position to which the Primary Care Provider (PCP)"
  1.  W !,"                      is assigned."
  1.  W !,"Date Scheduled for    Date patient will be inactivated from PCMM and their Primary Care team and provider/position unless"
  1.  W !," Inactivation         they have a completed outpatient appointment encounter with their current PCP or AP before this date."
  1.  W !,"                      Note: There is a patient reassignment option, which allows an inactivated patient to be reactivated"
  1.  W !,"                      to their previous Primary Care team and position if they return for care."
  1.  W !,"Reason for Extended   The reason entered for extending the patient's time before inactivation from PC panels."
  1.  W !," Inactivation         Entry of this field is in the PCMM GUI, Patient drop down menu, and the Extend Patient's Date for"
  1.  W !,"                      Inactivation from PC Panels option."
  1.  Q
  1. EXTCHUI ;roll n scroll option to extend a patient
  1.  N DA,DIC,DIE,DR,SCTM,SCARRAY,SCHIGH,SCX,V1
  1.  S SCTM=0 F  D P1 Q:+SCTM<1
  1.  Q
  1. P1 D GCL S DIC="^SCTM(404.51,",DIC(0)="AEQMZ" D ^DIC S SCTM=+Y Q:+SCTM<1
  1.  W !,"Searching...",!
  1.  D EXTEND(.SCARRAY,SCTM)
  1.  I $G(^TMP("SCMCTSK9","OUT",$J,1))="<DATA>" W !,"No Patients to Extend..." D GCL Q
  1.  S SCHIGH=$O(^TMP("SCMCTSK9","OUT",$J,9999999),-1)
  1.  S SCX=999 F  Q:(SCX="^")!(SCX="")  D P2
  1.  Q
  1. P2 W !,"Select From:  ",!!
  1.  S V1=0 F  S V1=$O(^TMP("SCMCTSK9","OUT",$J,V1)) Q:'V1  D
  1.  . W $J(V1,2)_" ",$P(^TMP("SCMCTSK9","OUT",$J,V1),U,3),!
  1.  F  W !,"Select 1-",SCHIGH," " R SCX:DTIME Q:(SCX="^")!(SCX="")!((SCX'>SCHIGH)&(SCX>0))  D
  1.  . I $E(SCX,1)="?" W !,"Select 1-",SCHIGH," or '^' to exit" Q
  1.  . I (+SCX<1)!(+SCX>SCHIGH) W !,"Select a valid number" Q
  1.  I SCX'?1.9N Q
  1.  S DIE="^SCPT(404.43,"
  1.  S DA=$P(^TMP("SCMCTSK9","OUT",$J,SCX),U)
  1.  S DR=".13//DO NOT EXTEND;S Y=.16 I X=4 S Y=.14;.14;.16////"_DUZ
  1.  D ^DIE
  1.  Q
  1. EXTEND(DATA,SCTEAM) ;return list of patients to inactivate in next 60 days
  1.  ;IEN^POSITION^PATIENT^EXTENDED^REASON
  1.  K DATA,SCDATA,SDDATA
  1.  N CNT,I,J,K,A,POSA S CNT=1 S SCTEAM=$G(SCTEAM),^TMP("SCMCTSK9","OUT",$J,1)="<DATA>"
  1.  D DT^DICRW S X="T-9M" D ^%DT S STDT=Y
  1.  S X="T-21M" D ^%DT S TYDT=+Y  ;MAKE THIS 21
  1.  S POSA=""
  1.  F  S POSA=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA)) Q:POSA=""  D
  1.  .F POS=0:0 S POS=$O(^SCTM(404.57,"ATMPOS",+SCTEAM,POSA,POS)) Q:'POS  D POS
  1. EX1 S A="^TMP(""SCMCTSK9"",$J)",CNT=1 F  S A=$Q(@A) Q:A=""!($P(A,",",2)'=$J)  D
  1.  .S B=@A
  1.  .S ^TMP("SCMCTSK9","OUT",$J,CNT)=(+$P(B,U,3))_U_$TR($P($P(A,"(",4),","),$C(34))_U_$TR($P(B,U,2),$C(34))_U_$P($G(^SCPT(404.43,+$P(B,U,3),0)),U,13)_U_$P($G(^SCPT(404.43,+$P(B,U,3),0)),U,14)
  1.  .S CNT=CNT+1
  1.  Q
  1. POS I '$$DATES^SCAPMCU1(404.59,POS) Q   ;Not an active position
  1.  I '$P($G(^SCTM(404.57,POS,0)),U,4) Q  ;Not PC
  1.  ;get patients for this position
  1.  K ^TMP("SC TMP LIST",$J)
  1.  S X=$$PTTP^SCAPMC(POS,"",.SCLIST,.SCERR)
  1.  S J=0 F  S J=$O(@SCLIST@(J)) Q:'J  S SCDATA=^(J) D
  1.  .N J I $P(SCDATA,U,4)>STDT Q
  1.  .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,5) Q
  1.  .I '$P($G(^SCPT(404.43,+$P(SCDATA,U,3),0)),U,15) Q
  1.  .S DFN=+SCDATA
  1.  .D SEEN Q:SEEN
  1.  .S ^TMP("SCMCTSK9",$J,$P($G(^SCTM(404.57,POS,0)),U),$P(SCDATA,U,2),+SCDATA)=SCDATA,CNT=CNT+1
  1.  K @SCLIST
  1.  Q
  1. SEEN ;was patient seen
  1.  S SEEN=0
  1.  N SCPRO,I,PRECP,PRO
  1.  N X,SCPRDTS,SCPR
  1.  ;get list of providers for this position
  1.  S PROV=+$$GETPRTP^SCAPMCU2(POS,DT) S SCPRO(+PROV)=""
  1.  S SCPRDTS("BEGIN")=TYDT
  1.  S SCPRDTS("END")=DT
  1.  S X=$$PRTP^SCAPMC(POS,"SCPRDTS","SCPR")
  1.  F I=0:0 S I=$O(SCPR(I)) Q:'I  S SCPRO(+SCPR(I))=""
  1.  S PRECP=0 I $G(PREC),$G(PREC)'=POS S PRECP=+$$GETPRTP^SCAPMCU2(PREC,DT),SCPRO(+PRECP)=""
  1.  F I=TYDT:0 S I=$O(^SCE("ADFN",DFN,I)) Q:'I  D  Q:SEEN
  1.  .F J=0:0 S J=$O(^SCE("ADFN",DFN,I,J)) Q:'J  D  Q:SEEN
  1.  ..N VISIT S VISIT=+$P($G(^SCE(J,0)),U,5) I $G(^SCE(J,0))<$G(TYDT) Q
  1.  ..F PRO=0:0 S PRO=$O(SCPRO(PRO)) Q:'PRO  D  Q:SEEN
  1.  ...I $D(^SDD(409.44,"AO",J,$G(PRO))) S SEEN=1 Q  ;GET THE PROVIDERJ
  1.  ...N V F V=0:0 S V=$O(^AUPNVPRV("AD",VISIT,V)) Q:'V  I PRO=(+$G(^AUPNVPRV(V,0))) S SEEN=1 Q
  1.  Q
  1. GCL ;clean temp globals
  1.  K ^TMP("SCMCTSK9",$J)
  1.  K ^TMP("SCMCTSK9","OUT",$J)
  1.  Q