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

SCRPU3.m

Go to the documentation of this file.
  1. SCRPU3 ;ALB/CMM - GENERIC UTILITIES ; 9/26/05 8:50am
  1. ;;5.3;Scheduling;**41,45,52,140,181,177,432,433,346**;AUG 13, 1993
  1. ;
  1. ELIG(DFN) ;
  1. ;Gets Primary Eligibility
  1. N PRIM
  1. I '$D(^DPT(DFN,.36)) Q 0
  1. I '$D(^DIC(8,+$P(^DPT(DFN,.36),"^"),0)) Q 0
  1. S PRIM=$P($G(^DIC(8,$P($G(^DPT(DFN,.36)),"^"),0)),"^",9)
  1. ;MAS Primary Eligibility Code
  1. S PRIM=$P($G(^DIC(8.1,PRIM,0)),"^")
  1. ;
  1. S PRIM=$TR(PRIM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. I PRIM="NON-SERVICE CONNECTED" S PRIM="NSC"
  1. I PRIM["SERVICE CONNECTED" S PRIM=$P(PRIM,"SERVICE CONNECTED")_"SC"_$P(PRIM,"SERVICE CONNECTED",2,999)
  1. I PRIM["LESS THAN" S PRIM=$P(PRIM,"LESS THAN")_"<"_$P(PRIM,"LESS THAN",2,999)
  1. I PRIM[" TO " S PRIM=$P(PRIM," TO ")_"-"_$P(PRIM," TO ",2,999)
  1. I PRIM["%" S PRIM=$TR(PRIM,"%","")
  1. S PRIM=$E(PRIM,1,9)
  1. Q PRIM
  1. ;
  1. GETNEXT(DFN,CLN) ;
  1. ;Get next appointment for patient (DFN) at Clinic (CLN)
  1. ;Returning the date in 00/00/0000 format
  1. N NEXT,APPT,FOUND
  1. ;
  1. N SDARRAY,SDCOUNT,SDDATE,SDAPPT,SDSTATUS,%
  1. ; Tell SDAPI that we want only the next appointment based on:
  1. ; Date SDARRAY(1)=Today's Date;
  1. ; Clinic SDARRAY(2)=CLN
  1. ; Patient SDARRAY(4)=DFN
  1. ; Status SDARRAY(3)="R;I;NS;NSR;NT"
  1. ; KEPT/INPATIENT/NOSHOW/NOSHOWRESCHED/NOACTIONTAKEN
  1. ; and that we want to have field 3 (appt status) returned
  1. ; SDARRAY("FLDS")="3"
  1. ; DATA will be returned in ^TMP($J,"SDAMA301",DFN,CLN,SDDATE)
  1. ;
  1. S FOUND=0,NEXT=""
  1. I $G(CLN)=""!($G(DFN)="") Q NEXT
  1. D NOW^%DTC S SDARRAY(1)=$P(%,".",1)_";"
  1. S SDARRAY(2)=CLN,SDARRAY(3)="R;I;NS;NSR;NT",SDARRAY(4)=DFN,SDARRAY("FLDS")="3",SDARRAY("MAX")=1
  1. S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
  1. I SDCOUNT>0 S SDDATE="" S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLN,SDDATE)) D
  1. .S NEXT=$TR($$FMTE^XLFDT(SDDATE,"5DF")," ","0")
  1. I SDCOUNT<0 D ;do processing for errors
  1. .; None to do in this case -- return null
  1. .Q
  1. ; when finished with all processing, kill SDAPI output array
  1. K ^TMP($J,"SDAMA301")
  1. Q NEXT
  1. ;
  1. GETLAST(DFN,CLN) ;
  1. ;Get last appointment for patient (DFN) at Clinic (CLN)
  1. ;Returning the date in 00/00/0000 format
  1. N LAST,APPT,FOUND,STATUS
  1. N SDARRAY,SDCOUNT,SDDATE,SDAPPT,SDSTATUS,%
  1. ; Tell SDAPI that we want only the next appointment based on:
  1. ; Date SDARRAY(1)=;Today's Date
  1. ; Clinic SDARRAY(2)=CLN
  1. ; Patient SDARRAY(4)=DFN
  1. ; Status SDARRAY(3)="R;I;NT"
  1. ; MAX SDARRAY("MAX")=-1
  1. ; and that we want to have field 3 (appt status) returned
  1. ; SDARRAY("FLDS")="3"
  1. ; DATA will be returned in ^TMP($J,"SDAMA301",DFN,CLN,SDDATE)
  1. ;
  1. S FOUND=0,LAST=""
  1. I $G(CLN)=""!($G(DFN)="") Q LAST
  1. D NOW^%DTC S SDARRAY(1)=";"_$P(%,".",1)
  1. S SDARRAY(2)=CLN,SDARRAY(3)="R;I;NT",SDARRAY(4)=DFN,SDARRAY("MAX")=-1
  1. S SDARRAY("FLDS")="3"
  1. S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
  1. I SDCOUNT>0 S SDDATE="" D
  1. .S SDDATE=$O(^TMP($J,"SDAMA301",DFN,CLN,SDDATE))
  1. .S LAST=$TR($$FMTE^XLFDT(SDDATE,"5DF")," ","0")
  1. I SDCOUNT<0 D ;do processing for errors
  1. .Q ; None to do in this case
  1. ; when finished with all processing, kill SDAPI output array
  1. K ^TMP($J,"SDAMA301")
  1. Q LAST
  1. ;
  1. PDEVICE() ;
  1. ;Generic Printer Call
  1. N TION,POP
  1. S %ZIS="QN" D ^%ZIS K %ZIS Q:POP!(ION="^") -1
  1. S TION=ION
  1. I $D(IO("Q")) S TION="Q;"_TION
  1. Q TION_"^"_IOST
  1. ;
  1. GETTIME() ;
  1. ;Prompt for Queue Time
  1. N X,Y
  1. S DIR(0)="D^::RFE",DIR("A")="Start Time",DIR("B")="NOW"
  1. D ^DIR
  1. I $D(DTOUT)!(X="") S Y=$H
  1. I $D(DUOUT)!($D(DIROUT)) S Y=-1
  1. K DIR,DTOUT,DUOUT,DIROUT
  1. Q Y
  1. ;
  1. HOLD(PAGE,TIT,MARG) ;
  1. ;device is home, reached end of page
  1. N X
  1. S MARG=$G(MARG) S:MARG'>80 MARG=80
  1. W !!,"Press Any Key to Continue or '^' to Quit" R X:DTIME
  1. I '$T!(X="^") S STOP=1 Q
  1. D NEWP1(.PAGE,TIT,MARG)
  1. Q
  1. ;
  1. NEWP1(PAGE,TITL,MARG) ;
  1. ;new page
  1. ;
  1. S MARG=$G(MARG) S:MARG'>80 MARG=80
  1. D STOPCHK^DGUTL
  1. I $G(STOP) D STOPPED^DGUTL Q
  1. W:PAGE>0 @IOF
  1. S PAGE=PAGE+1
  1. D TITLE(PAGE,TITL,MARG)
  1. Q
  1. ;
  1. TITLE(PG,TITL,MARG) ;
  1. N PDATE,SCX,SCI
  1. S MARG=$G(MARG) S:MARG'>80 MARG=80
  1. S PDATE=$$FMTE^XLFDT(DT,"5D")
  1. S SCI=(IOM-$L(TITL)\2) S:SCI<24 SCI=24
  1. S SCX="Printed on: "_PDATE
  1. S $E(SCX,SCI)=TITL
  1. S $E(SCX,(IOM-6-$L(PG)))="Page: "_PG
  1. W SCX,!
  1. Q
  1. ;
  1. CLOSE ;close device
  1. D:$E(IOST)'="C" ^%ZISC
  1. Q
  1. ;
  1. OPEN ;opens device
  1. IF IOST?1"C-".E D Q ;%zis has already been called via $$pdevice
  1. .W @IOF
  1. D ^%ZIS
  1. Q:POP
  1. U IO
  1. Q
  1. ;
  1. NODATA(TITL) ;
  1. ;no data to print
  1. ;returns 1
  1. D OPEN
  1. D TITLE(1,TITL)
  1. W !,"No data to report"
  1. D CLOSE
  1. Q 1
  1. ;
  1. HELP W:'$D(VAUTNA) !,"ENTER:",!?5,"- A or ALL for all ",VAUTSTR,"s, or"
  1. W:($D(VAUTTN))&(VAUTSTR="TEAM") !?5,"- N or NOT for not assigned to a team or"
  1. W:($D(VAUTPO))&(VAUTSTR="PRACTITIONER") !?5,"- N or NONE or NOT for not assigned to a Practitioner"
  1. W !?5,"- Select individual "_VAUTSTR W:'$D(VAUTPO) " -- limit 20"
  1. W !?5,"Imprecise selections will yield an additional prompt."
  1. I $O(@VAUTVB@(0))]"" W !?5,"- An entry preceeded by a minus [-] sign to remove entry from list."
  1. I $O(@VAUTVB@(0))]"" W !,"NOTE, you have already selected:" S VAJ=0 F VAJ1=0:0 S VAJ=$O(@VAUTVB@(VAJ)) Q:VAJ="" W !?8,$S(VAUTNI=1:VAJ,1:@VAUTVB@(VAJ))
  1. Q
  1. ;
  1. CONV(ORIGA,NEWA) ;
  1. ;ORIGA - original array - name(ien)=data
  1. ;NEWA - new array - name(n)=ien^data
  1. ;
  1. N ENT,CNT
  1. S ENT=0,CNT=0
  1. S NEWA=ORIGA
  1. F S ENT=$O(ORIGA(ENT)) Q:ENT=""!(ENT'?.N) D
  1. .S CNT=CNT+1
  1. .S NEWA(CNT)=ENT_"^"_ORIGA(ENT)
  1. Q