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

SDECRMG1.m

Go to the documentation of this file.
  1. SDECRMG1 ;ALB/SAT/JSM - VISTA SCHEDULING RPCS ;MAR 15, 2017
  1. ;;5.3;Scheduling;**627,642,651,658**;Aug 13, 1993;Build 23
  1. ;
  1. ; The following entry point causes the ^XTMP("SDEC","IDX" global
  1. ; to be rebuilt based on the scheduling of the SDEC BUILD IDX option.
  1. WAIT(SDCY,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTE,ORIGDTR,SDCNT,MGIENS,SDALL) ;EP
  1. ;Key stored in 56th piece
  1. ;SVCCONNP - 37th piece
  1. ;Desired DATE - 24th piece
  1. ;Origination Date - ORIGDT - 8th piece
  1. ;Priority Group - 33th piece
  1. ;IEN in 7th piece
  1. Q:+URG ;only check consults if urgency filter passed in
  1. N %DT,LP,NOD,GBL,DLM,TYP,SDCF,SDI,SVCL,X,Y
  1. N RET,WLIEN1,LASTSUB
  1. S SVCL=""
  1. S SDCF=1
  1. I +CLINIC S SDCF=0 D
  1. .S SDI="" F S SDI=$O(CLINIC(SDI)) Q:SDI="" D Q:SDCF=1
  1. ..S:$O(^SDWL(409.32,"B",SDI,0)) SDCF=1
  1. Q:'+SDCF
  1. S SDMAX=$G(SDMAX,50)
  1. S GBL="~SDWL(409.3,"
  1. S DLM="|",TYP="E",LASTSUB=""
  1. S WLIEN1=$G(WLIEN1),MAXREC=$G(MAXREC),SDBEG=$G(SDBEG),SDEND=$G(SDEND),DFN=$G(DFN),CLINIC=$G(CLINIC)
  1. S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. S:SDEND="" SDEND=$S(DFN'="":4141015,1:$$FMADD^XLFDT($$NOW^XLFDT,-90)) ;alb/sat 658 use valid FM range instead of 9991231
  1. S SCVISIT=$G(SCVISIT)
  1. S SVCR=$G(SVCR)
  1. S SDSVC=$G(SDSVC) I +SDSVC S SVCL=$$SVCL(.SDSVC)
  1. S SDLASTE=$G(SDLASTE)
  1. F D Q:SDLASTE="" Q:SDCNT'<SDMAX
  1. .D WLGET^SDEC(.RET,WLIEN1,SDMAX-SDCNT,SDBEG,SDEND,DFN,SDLASTE,+$D(SORT("B","ETOPD")),SVCL,DESDT,PRI,SVCR,SCVISIT,CLINIC,ORIGDT) ;alb/sat 658 add SVCL...
  1. .S X=$O(@RET@(9999999),-1) S NOD=@RET@(X) S SDLASTE=$P(NOD,U,56)
  1. .I 'X S SDLASTE="" Q
  1. .S LP=0 F S LP=$O(@RET@(LP)) Q:LP="" D Q:SDCNT'<SDMAX
  1. ..S NOD=@RET@(LP)
  1. ..Q:$D(MGIENS("E"_$P(NOD,U,7)))
  1. ..D WAIT1(MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLASTA,.ORIGDTR,.SDCNT,NOD)
  1. Q
  1. WAIT1(MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTA,ORIGDTR,SDCNT,NOD,MGIENS,SDALL) ;get/check/process 1 entry
  1. N CLGP,DDTE,DESGP,IEN,ODTE,ORIGGP,PGRP,PT,SCPRI,SORTSTR,SVCP,SVCPINV,TYP,WAITD
  1. S TYP="E"
  1. S PGRP=$P(NOD,U,33) ;compare to ENROLLMENT PRIORITY 28 instead of Patient's Priority Group in 33
  1. S PT=$P(NOD,U,1)
  1. I PTS'="",PT'="",$D(PTS(PT))=0 Q ;No match on patients
  1. I PGRP="" S PGRP="GROUP 0"
  1. I PRIGRP=1,$D(PRI(PGRP))=0 Q ;No match on priority group
  1. S CLGP=$P(NOD,U,16) ;I CLGP'="" S CLGP=$$GET1^DIQ(409.32,CLGP_",",.01,"I")
  1. I +CLINIC,CLGP="" Q
  1. I +CLINIC,CLGP'="",$D(CLINIC(CLGP))=0 Q ;match clinic filter
  1. I CLGP'="",$$GET1^DIQ(44,CLGP_",",50.01,"I")=1 Q ;do not return if OOS? is yes
  1. S DESGP=$P(NOD,U,24)
  1. I DESDT'="",DESGP'="",$D(DESDT(DESGP))=0 Q ;match date of request with desired date
  1. I DESDTR'="",DESGP'="",(DESGP<$P(DESDTR,"~",1))!(DESGP>$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates
  1. S ORIGGP=$P(NOD,U,8)
  1. I ORIGDTR'="",ORIGGP'="",(ORIGGP<$P(ORIGDTR,"~",1))!(ORIGGP>$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date
  1. I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date
  1. S IEN=$P(NOD,U,7)
  1. S SVCP=$P(NOD,U,37)
  1. S SVCPINV=100-SVCP
  1. I SCVISIT'="",SCVISIT'="BOTH" Q:(SCVISIT="NO")&($P(NOD,U,36)="") Q:SCVISIT'=$P(NOD,U,36) ;SCVisit for filter (patient)
  1. S SCPRI=$P(NOD,U,26)="YES"
  1. S SVCREL=$P(NOD,U,44)="YES" ;SVCREL is the SCVisit header on RMGrid ;alb/sat 658
  1. I SVCR'="",SVCR'="BOTH" Q:(SVCR="NO")&($P(NOD,U,44)="") Q:SVCR'=$P(NOD,U,44) ;SERVICERELATED for filter (request)
  1. I +SDSVC Q:$P(NOD,U,15)="" Q:'$D(SDSVC($P(NOD,U,15))) ;Service/Clinic Stop
  1. S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$$CVTDT($P(NOD,U,8)))
  1. S WAITD=9999999-WAITD ;Wait days for sorting
  1. S ODTE=$P($$CVTDT($P(NOD,U,8)),".") ;Origination date for sorting
  1. S DDTE=$P($$CVTDT($P(NOD,U,24)),".") ;Desired date for sorting
  1. ;S SORTSTR=$$SORT(.SORT)
  1. S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,.MGIENS,SVCREL) ;alb/sat 658 - add SVCREL
  1. D SETNODE(WAITD,TYP,IEN,NOD,56,SORTSTR,.SDCNT)
  1. ;S SDCNT=SDCNT+1
  1. Q
  1. APPT(SDECY,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTA,ORIGDTR,SDCNT,MGIENS,SDALL,MRTC) ; EP get data from appt request file
  1. Q:'$$TEST("ARGET^SDECAR1")
  1. Q:+URG ;only check consults if urgency filter passed in
  1. ;Key stored in 56th piece
  1. ;SVCCONNP - 30th piece
  1. ;Desired DATE - 20th piece
  1. ;Origination Date - ORIGDT - 8th piece
  1. ;Priority Group - 26th piece
  1. ;IEN in 7th piece
  1. N LP,NOD,GBL,DLM,SVCL,TYP,X
  1. N RET,LASTSUB
  1. S SDMAX=$G(SDMAX,50)
  1. S SCVISIT=$G(SCVISIT)
  1. S SVCR=$G(SVCR)
  1. S SDSVC=$G(SDSVC)
  1. S LASTSUB=""
  1. S DLM="|",TYP="A"
  1. S GBL="~SDEC(409.85,"
  1. S MAXREC=$G(MAXREC),SDBEG=$G(SDBEG),SDEND=$G(SDEND),DFN=$G(DFN),CLINIC=$G(CLINIC)
  1. S:SDBEG="" SDBEG=1410102 ;alb/sat 658 use valid FM range instead of 1000101
  1. S:SDEND="" SDEND=$S(DFN'="":4141015,1:$$FMADD^XLFDT($$NOW^XLFDT,-90)) ;alb/sat 658 use valid FM range instead of 9991231
  1. S SVCL="" S SDSVC=$G(SDSVC) I +SDSVC S SVCL=$$SVCL(.SDSVC)
  1. S SDLASTA=$G(SDLASTA)
  1. F D Q:SDLASTA="" Q:SDCNT'<SDMAX ;we throw some records out based on filters; continue until there are SDMAX records
  1. .D ARGET^SDEC(.RET,,SDMAX-SDCNT,SDBEG,SDEND,DFN,SDLASTA,,SVCL,DESDT,PRI,SVCR,SCVISIT,CLINIC,ORIGDT)
  1. .S X=$O(@RET@(9999999),-1) S NOD=@RET@(X) S SDLASTA=$P(NOD,U,56) ;get LASTSUB
  1. .I 'X S SDLASTA="" Q
  1. .S LP=0 F S LP=$O(@RET@(LP)) Q:LP="" D Q:SDCNT'<SDMAX
  1. ..S NOD=@RET@(LP)
  1. ..Q:$D(MGIENS("A"_$P(NOD,U,7)))
  1. ..D APPT1(MAXREC,DFN,SDBEG,SDEND,.CLINIC,.PRI,SCVISIT,SVCR,.ORIGDT,.DESDT,DESDTR,PRIGRP,.SORT,.PTS,SDMAX,.URG,.SDSVC,.SDLASTA,.ORIGDTR,.SDCNT,NOD,,.MRTC) ;alb/jsm 658 added MRTC
  1. Q
  1. APPT1(MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTA,ORIGDTR,SDCNT,NOD,MGIENS,MRTC) ;get/check/process 1 entry
  1. N CLGP,DDTE,DESGP,IEN,ODTE,ORIGGP,PGRP,PT,SCPRI,SORTSTR,SVCP,SVCPINV,TYP,WAITD
  1. S TYP="A"
  1. S PGRP=$P(NOD,U,26) ;compare to ENROLLMENT PRIORITY 22 instead of Patient's Priority Group in 26
  1. I PGRP="" S PGRP="GROUP 0" ;Priority Grp
  1. S PT=$P(NOD,U,1) ;Patient
  1. I PTS'="",PT'="",$D(PTS(PT))=0 Q ;match clinic
  1. I PRIGRP=1,$D(PRI(PGRP))=0 Q ;No match on priority group
  1. S CLGP=$P(NOD,U,12)
  1. I +CLINIC,$D(CLINIC(+CLGP))=0 Q ;match clinic
  1. I CLGP'="",$$GET1^DIQ(44,CLGP_",",50.01,"I")=1 Q ;do not return if OOS? is yes
  1. S DESGP=$P(NOD,U,20)
  1. I DESDT'="",DESGP'="",$D(DESDT(DESGP))=0 Q ;match date of request with desired date
  1. I DESDTR'="",DESGP'="",(DESGP<$P(DESDTR,"~",1))!(DESGP>$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates
  1. I (MRTC='""),(+MRTC'=+$P(NOD,U,23)) Q ;match multiple appointment RTC alb/jsm 658
  1. S ORIGGP=$P(NOD,U,8)
  1. I ORIGGP'="",(ORIGGP>SDEND)!(ORIGGP<SDBEG) Q
  1. I ORIGDTR'="",ORIGGP'="",(ORIGGP<$P(ORIGDTR,"~",1))!(ORIGGP>$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date
  1. I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date
  1. S IEN=$P(NOD,U,7)
  1. S SVCP=$P(NOD,U,30)
  1. S SVCPINV=100-SVCP
  1. I SCVISIT'="",SCVISIT'="BOTH" Q:(SCVISIT="NO")&($P(NOD,U,29)="") Q:SCVISIT'=$P(NOD,U,29) ;SCVisit for filter (patient)
  1. S SCPRI=$S($P(NOD,U,29)="YES":0,1:1) ;SCVisit for sorting
  1. I SVCR'="",SVCR'="BOTH" Q:(SVCR="NO")&($P(NOD,U,37)="") Q:SVCR'=$P(NOD,U,37) ;SERVICERELATED for filter (request)
  1. S SVCREL=$P(NOD,U,37)="YES" ;SVCREL is the SCVisit header on RMGrid alb/sat 658
  1. I +SDSVC Q:$P(NOD,U,58)="" Q:'$D(SDSVC($P(NOD,U,58))) ;Service/Clinic Stop
  1. S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$P(NOD,U,8))
  1. S WAITD=9999999-WAITD
  1. S ODTE=$P($$CVTDT($P(NOD,U,8)),".")
  1. S DDTE=$P($$CVTDT($P(NOD,U,20)),".")
  1. ;S SORTSTR=$$SORT(.SORT)
  1. S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,.MGIENS,SVCREL) ;alb/sat 658 - add SVCREL
  1. D SETNODE(WAITD,TYP,IEN,NOD,56,SORTSTR,.SDCNT)
  1. ;S SDCNT=SDCNT+1
  1. Q
  1. ;
  1. ;Return recall list
  1. RECALL(RET,MAXREC,DFN,SDBEG,SDEND,CLINIC,PRI,SCVISIT,SVCR,ORIGDT,DESDT,DESDTR,PRIGRP,SORT,PTS,SDMAX,URG,SDSVC,SDLASTR,ORIGDTR,SDCNT,MGIENS,SDALL) ;EP
  1. Q:'$$TEST("RECGET^SDEC52")
  1. Q:+URG ;only check consults if urgency filter passed in
  1. ;Key stored in 42nd piece
  1. ;SVCCONNP - 29th piece
  1. ;Desired DATE - 19th piece - External format
  1. ;Origination Date - ORIGDT - 32nd piece
  1. ;Priority Group - 25th piece
  1. ;IEN - 1st piece
  1. N LP,NOD,GBL,SVCP,PG,DD,OD,DLM,TYP,PT,SORTSTR,SVCP,SCPRI,ORIGGP
  1. N CLGP,IEN,PGRP,SDECY,SDI,SDCLL,SVCP,SVCPINV,LASTSUB,ODTE,DDTE,WAITD,X ;alb/sat 658 add SDI
  1. Q:$G(SVCR)'="" ;only SD WAIT LIST and SDEC APPT REQUEST have this value
  1. S SDCLL=""
  1. S SDSVC=$G(SDSVC)
  1. S SDMAX=$G(SDMAX,50)
  1. S GBL="~SD(403.5,"
  1. S DLM="|",TYP="R",LASTSUB=""
  1. S DFN=$G(DFN),SDBEG=$G(SDBEG),SDEND=$G(SDEND),MAXREC=$G(MAXREC),SDLASTR=$G(SDLASTR),CLINIC=$G(CLINIC)
  1. I $D(CLINIC) S SDI="" F S SDI=$O(CLINIC(SDI)) Q:SDI="" S SDCLL=SDCLL_$S(SDCLL'="":U,1:"")_SDI ;alb/sat 658
  1. F D Q:SDLASTR="" Q:SDCNT'<SDMAX ;we throw some records out based on filters; continue until there are SDMAX records
  1. .D RECGET^SDEC(.SDECY,DFN,SDBEG,SDEND,SDMAX-SDCNT,SDLASTR,,,1,SDCLL) ;alb/sat 658 add SDCLL param
  1. .S X=$O(@SDECY@(9999999),-1) S NOD=@SDECY@(X) S SDLASTR=$P(NOD,U,42) ;get LASTSUB ;alb/sat 642 change 56 to 42
  1. .I 'X S SDLASTR="" Q
  1. .S LP=0 F S LP=$O(@SDECY@(LP)) Q:LP="" D
  1. ..S NOD=@SDECY@(LP)
  1. ..S CLGP=$P(NOD,U,16) Q:CLGP="" ;Clinic ID ;alb/sat 651
  1. ..S SVCP=$P(NOD,U,29) ;Service connected percentage
  1. ..S SVCPINV=100-SVCP
  1. ..S PGRP=$P(NOD,U,25)
  1. ..S PT=$P(NOD,U,2) ;Patient
  1. ..I PTS'="",PT'="",$D(PTS(PT))=0 Q
  1. ..I PGRP="" S PGRP="GROUP 0" ;Priority Grp
  1. ..I PRIGRP'="",$D(PRI(PGRP))=0 Q ;No match on priority group
  1. ..I +CLINIC,CLGP'="",$D(CLINIC(CLGP))=0 Q ;match clinic
  1. ..I CLGP'="",$$GET1^DIQ(44,CLGP_",",50.01,"I")=1 Q ;do not return if OOS? is yes
  1. ..I +SDSVC N SDSVCN S SDSVCN=$$GET1^DIQ(44,+$P(NOD,U,16)_",",8,"E") Q:SDSVCN="" Q:'$D(SDSVC(SDSVCN)) ;check service
  1. ..S DESGP=$P(NOD,U,19) I DESGP'="" S %DT="",X=DESGP D ^%DT S DESGP=$S(Y=-1:"",1:Y) ;alb/sat 658 use internal time
  1. ..I DESDT'="",DESGP'="",$D(DESDT(DESGP))=0 Q ;match date of request with desired date
  1. ..I DESDTR'="",DESGP'="",(DESGP<$P(DESDTR,"~",1))!(DESGP>$P(DESDTR,"~",2)) Q ;match date of request with range of desired dates
  1. ..S ORIGGP=$P(NOD,U,32)
  1. ..I ORIGDTR'="",ORIGGP'="",(ORIGGP<$P(ORIGDTR,"~",1))!(ORIGGP>$P(ORIGDTR,"~",2)) Q ;match origination date range with file entry date
  1. ..I ORIGDT'="",ORIGGP'="",$D(ORIGDT(ORIGGP))=0 Q ;match origination date with file entry date
  1. ..S IEN=$P(NOD,U,1)
  1. ..I SCVISIT'="",SCVISIT'="BOTH" Q:(SCVISIT="NO")&($P(NOD,U,28)="") Q:SCVISIT'=$P(NOD,U,28) ;SCVisit for filter (patient)
  1. ..S SCPRI=0 ;SCVisit for sorting
  1. ..S SVCREL=$S(PGRP="GROUP 1":1,1:"") ;SVCREL is the SCVisit header on RMGrid; Service Related alb/sat 658 - If Priority Group 1, treat as service related as 'YES', treat as 'NO' for all other Priority Groups.
  1. ..S WAITD=$$FMDIFF^XLFDT($P($$NOW^XLFDT,".",1),$$CVTDT($P(NOD,U,19)))
  1. ..S WAITD=9999999-WAITD
  1. ..S ODTE=$P($$CVTDT($P(NOD,U,32)),".")
  1. ..S DDTE=$P($$CVTDT($P(NOD,U,19)),".")
  1. ..;S SORTSTR=$$SORT(.SORT)
  1. ..S SORTSTR=$$SORT(.SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,,SVCREL) ;alb/sat 658 - add SVCREL
  1. ..D SETNODE(WAITD,TYP,IEN,NOD,42,SORTSTR,.SDCNT)
  1. ..;S SDCNT=SDCNT+1
  1. Q
  1. ;
  1. SETNODE(S1,S2,S3,VAL,KEYP,SLIST,CNT) ;EP-
  1. ; S1 =Wait Days
  1. ; S2 =Request Type - A C E R
  1. ; S3 =Request Type IEN
  1. ; VAL = Request Type data from rpc call
  1. ; KEYP = Storage piece number where LASTSUB is stored
  1. ; SLIST = Sort String from $$SORT
  1. Q:'$L($D(S1))!'$L($D(S2))!'$L($D(S3))
  1. N KEY,DLM
  1. S DLM="|"
  1. Q:$D(^TMP("SDECIDX",$J,"XREF-ID",S2_DLM_S3)) ;quit if duplicate
  1. ;S KEY=9999999-S1_DLM_S2_DLM_S3_DLM_SLIST
  1. S KEY=SLIST_DLM_S3
  1. S CNT=$G(CNT)+1
  1. S VAL=$P(VAL,$C(30))
  1. S:$G(KEYP) $P(VAL,U,KEYP)=KEY
  1. S ^TMP("SDECIDX",$J,"DATA",CNT)=$G(VAL)
  1. S ^TMP("SDECIDX",$J,"XREF",KEY)=S2_U_S3_U_KEY
  1. S ^TMP("SDECIDX",$J,"COUNT")=CNT
  1. S ^TMP("SDECIDX",$J,"XREF-ID",S2_DLM_S3)=""
  1. Q
  1. ;
  1. SETNODEP(GBL,VAL) ;EP-
  1. Q:'$L($D(GBL))
  1. S ^XTMP("SDEC","IDX","PATTERNS",GBL)=$P($G(VAL),$C(30))
  1. Q
  1. ;
  1. PC(VAL,PIECE,DLM) ;EP-
  1. S DLM=$G(DLM,U)
  1. Q $P($G(VAL),DLM,+$G(PIECE))
  1. ;
  1. ;SORT(SORT) ;Sort out the variables
  1. SORT(SORT,IEN,WAITD,TYP,PT,SVCPINV,PGRP,CLGP,DDTE,ODTE,SCPRI,MGIENS,SVCREL) ;alb/sat 658 - add SVCREL
  1. N SOR,SCNT,SD,STRING,DLM,STR
  1. N STCNT,STID,STJ,STTYP
  1. S SCNT=0,(STR,STRING)="",DLM="|"
  1. I $D(MGIENS(TYP_IEN)) S STRING="0|0|0"
  1. S SOR="" F S SOR=$O(SORT(SOR)) Q:SOR'>0 D
  1. .S SCNT=SCNT+1
  1. .S SD=$G(SORT(SOR))
  1. .S STR=""
  1. .S STR=$S(SD="RTOPD":$S(TYP="R":0,1:1),SD="ATOPD":$S(TYP="A":0,1:1),SD="ETOPD":$S(TYP="E":0,1:1),SD="CTOPD":$S(TYP="C":0,1:1),1:"")
  1. .S:STR=0 STR=STR_"|"_$$PAD(999999999-IEN)
  1. .I SD="PRIORITYGROUP" D
  1. ..S STR=$S(PGRP="GROUP 0":0,PGRP="GROUP 1":1,PGRP="GROUP 2":2,PGRP="GROUP 3":3,PGRP="GROUP 4":4,PGRP="GROUP 5":5,PGRP="GROUP 6":6,PGRP="GROUP 7":7,PGRP="GROUP 8":8,1:0)
  1. ..S STR=STR_DLM_'SVCREL ;SVCREL is SCVISIT header on RMGRID ;alb/sat 658
  1. .S:STR="" STR=$S(SD="WAITTIME":WAITD,SD="REQUESTTYPE":TYP,SD="PATIENTNAME":PT,SD="SCVISIT":SVCPINV,SD="CLINICS":CLGP,SD="DESIREDDATE":DDTE,SD="ORIGINATIONDATE":ODTE,1:"")
  1. .I SD="PATIENTNAME" S STR=$$GET1^DIQ(2,PT_",",.01)
  1. .I SD="CLINICS" S STR=$$GET1^DIQ(44,CLGP_",",.01)
  1. .I STRING="" S STRING=STR
  1. .E S STRING=STRING_DLM_STR
  1. Q STRING
  1. ;
  1. PAD(STRING,CHAR,CNT) ;prepend characters (default is 0 zero) to STRING
  1. N SDI,SDR
  1. S STRING=$G(STRING)
  1. S CHAR=$G(CHAR)
  1. S:CHAR="" CHAR="0"
  1. S CNT=$G(CNT)
  1. S:+CNT CNT=+CNT+1
  1. S:'+CNT CNT=10 ;(9 characters)
  1. S $P(SDR,CHAR,CNT-$L(STRING))=STRING
  1. Q SDR
  1. ; Test for tag/routine
  1. TEST(X) ;EP
  1. N Z
  1. S:X[U Z=$P(X,U),X=$P(X,U,2)
  1. Q:'$L(X)!(X'?.1"%"1.AN) 0
  1. X ^%ZOSF("TEST")
  1. Q $S('$T:0,$G(Z)="":1,Z'?.1"%"1.AN:0,1:$T(@Z^@X)'="")
  1. ;
  1. TMPGBL() ;EP-
  1. K ^TMP("SDECIDX",$J) Q $NA(^($J))
  1. ; Convert external dates to FileMan format
  1. CVTDT(VAL) ;EP-
  1. D DT^DILF(,VAL,.VAL)
  1. Q VAL
  1. ; Returns inverse date value
  1. INVDT(VAL) ;EP-
  1. Q:(VAL<1) VAL
  1. Q (9999999.9999-VAL)
  1. RECCNT(DATA) ;EP-
  1. S DATA=$G(^TMP("SDECIDX",$J,"COUNT"))
  1. Q
  1. SVCL(SDSVC) ;build services list
  1. N SDI,SDR,SVC
  1. S SDR=""
  1. S SDI=0 F S SDI=$O(SDSVC(SDI)) Q:SDI="" D
  1. .S SVC=SDSVC(SDI)
  1. .Q:SVC=""
  1. .S SDR=SDR_$S(SDR'="":"|",1:"")_SVC
  1. Q SDR