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

PSJPDAPP.m

Go to the documentation of this file.
  1. PSJPDAPP ;BIR/MHA - SEND APPOINTMENTS TO PADE ;11/27/15
  1. ;;5.0;INPATIENT MEDICATIONS;**317,389,415,432**;16 DEC 97;Build 18
  1. ;Reference to ^PS(55 is supported by DBIA 2191
  1. ;Reference to ^ORD(101 supported by DBIA 872
  1. ;Reference to GETPLIST^SDAMA202 supported by DBIA 3869
  1. ;Reference to ^SC supported by DBIA 10040
  1. ;Reference to ^DPT supported by DBIA 10035
  1. Q
  1. ;
  1. EN ;
  1. N PDA,PDCL,PDCLA,PDI,PDJ,PDK,PSJAP,PSJCLPD,PSJPDNM,PSJDIV,DTP,SA,SEQ,I,J,K,L,P,X,Y,Z,PSJNIP,X1,X2
  1. S (DTP,PSJAP,I)=0
  1. K ^TMP($J,"PSJCLSA")
  1. F S I=$O(^PS(58.7,I)) Q:'I S J=$$PDACT^PSJPDCLA(I)
  1. Q:'PSJAP
  1. S I=0 F S I=$O(PSJAP(I)) Q:'I D
  1. . S DTP=+$G(^PS(58.7,I,1))
  1. . S J=0 F S J=$O(^PS(58.7,I,"DIV",J)) Q:'J D
  1. .. S Y=$G(^PS(58.7,I,"DIV",J,0)) I Y=""!($P(Y,"^",2)&($P(Y,"^",2)<DT)) Q
  1. .. S SA=""
  1. .. I $P(Y,"^",9)="Y" S:$P(Y,"^",4) SA=$P($G(^PS(58.71,$P(Y,"^",4),0)),"^") D ALLCLN ;send appt for all clinics
  1. .. D CLARR
  1. .. ; Get all CLINIC to SEND AREA associations, where
  1. .. ; INCLUDE CLINICS IN BG JOB and RE-SEND ORDERS AT CHECK-IN evaluates to YES
  1. .. D GETDSARS^PSJPDAPP(I,J,3)
  1. M PDCL=PDCLA
  1. I '$D(PDCL) D KILLTMP Q
  1. N SNM,CNM S SNM="PSJ SIU-S12 SERVER",CNM="PSJ SIU-S12 CLIENT"
  1. I '$O(^ORD(101,"B",SNM,0))!('$O(^ORD(101,"B",CNM,0))) Q
  1. N NHL D INIT^HLFNC2(SNM,.NHL) Q:$D(NHL)=1
  1. N NFS,NECH,HL,HLFS,NSEG,EDT,APT,DFN,PSJDTM,PSJND,PSJVP,PSJVNM,PSJDNS,PSJDNM,PSJOR,PSJORN
  1. M HL=NHL S (NFS,HLFS)=HL("FS"),NECH=$E(HL("ECH"),1)
  1. S PDI=0 F S PDI=$O(PDCL(PDI)) Q:'PDI D
  1. . S PSJND=$G(^PS(58.7,PDI,0))
  1. . S PSJVNM=$P(PSJND,"^"),PSJDNS=$P(PSJND,"^",2),PSJVP=$P(PSJND,"^",3)
  1. . S PDJ=0 F S PDJ=$O(PDCL(PDI,PDJ)) Q:'PDJ D
  1. .. S PSJDNM=$P($$SITE^VASITE(,PDJ),"^",3)
  1. .. S PDK=0 F S PDK=$O(PDCL(PDI,PDJ,PDK)) Q:'PDK D APPT
  1. D KILLTMP
  1. Q
  1. ;
  1. APPT ;
  1. K ^TMP($J,"SDAMA202")
  1. S PSJOR=PDK,PSJORN=$P(^SC(PDK,0),"^")
  1. S DTP=PDCL(PDI,PDJ,PDK)
  1. S EDT=DT
  1. I DTP S X1=DT,X2=+DTP D C^%DTC S EDT=X
  1. D GETPLIST^SDAMA202(PDK,"1;4","",DT,EDT)
  1. Q:'$D(^TMP($J,"SDAMA202"))
  1. K APDTM,CLNM,PSJXCL
  1. S PDA=0 F S PDA=$O(^TMP($J,"SDAMA202","GETPLIST",PDA)) Q:'PDA D
  1. . S PSJDTM=+^TMP($J,"SDAMA202","GETPLIST",PDA,1)
  1. . S DFN=+^TMP($J,"SDAMA202","GETPLIST",PDA,4)
  1. . Q:$P($G(^DPT(DFN,.1)),"^")]""&($P(^PS(58.7,PDI,0),"^",6)'="Y")
  1. . K NSEG N ZZ1,XX,FTS S (ZZ1,FTS)="",PSJNIP=0
  1. . I $P($G(^DPT(DFN,.1)),"^")]"" D
  1. .. D IN5^VADPT
  1. .. N PSJQ,PSJWD,PSJRBD
  1. .. S PSJWD=$P(VAIP(5),"^",2),PSJRBD=$P(VAIP(6),"^",2)
  1. .. S PSJQ=$$CHKPD^PSJPDCL(PSJWD,PSJRBD)
  1. .. I 'PSJQ S PSJNIP=1 Q
  1. .. S FTS=$P(VAIP(8),"^")_NECH_$P(VAIP(8),"^",2)
  1. .. S XX=0 F S XX=$O(PSJQ(XX)) Q:'XX D
  1. ... I XX=PDI,$P(PSJQ(XX),"^",2)'="" S ZZ1=$P(PSJQ(XX),"^",2)
  1. ... I XX'=PDI S PSJNIP=1
  1. ... I $G(PSJXCL(PDI)) S PSJNIP=0
  1. . S SEQ=0 D SRBLD^PSJPDCLA M HL=NHL N ZZ2 S ZZ2=$S($P(DTP,"^",2)'="":$P(DTP,"^",2),1:"")
  1. . S SEQ=SEQ+1,NSEG(SEQ)="ZZZ"_HL("FS")_$S(ZZ1'="":ZZ1,1:"")_HL("FS")_ZZ2_HL("FS")_FTS
  1. . K HLP,HLA,PSJSND S HLP="",HLP("SUBSCRIBER")="^^^^~"_PSJDNS_":"_PSJVP_"~DNS"
  1. . N XX S XX=PDI D PV19 M HLA("HLS")=NSEG
  1. . D GENERATE^HLMA(SNM,"LM",1,.PSJSND,"",.HLP)
  1. . D LOG^PSJPADE
  1. . ;check for O11 re-send
  1. . D RESNDORDS^PSJPDCLA(DFN,PSJOR,PDJ,PDI,3) ; Resend all orders for the input CLINIC's SEND AREA
  1. Q
  1. ;
  1. ALLCLN ;
  1. N ND S Z=0 F S Z=$O(^SC(Z)) Q:'Z D
  1. .S ND=^SC(Z,0) Q:$P(ND,"^",3)'="C" Q:$P(ND,"^",15)'=J
  1. .I $D(^SC(Z,"I")) S X=$G(^SC(Z,"I")) I $P(X,"^"),$P(X,"^",2)'>$P(X,"^") Q
  1. .S PDCL(I,J,Z)=DTP_$S(SA]"":"^"_SA,1:"")
  1. Q
  1. ;
  1. CLARR ;
  1. S Z=0,SA=""
  1. F S Z=$O(^PS(58.7,I,"DIV",J,"CL",Z)) Q:'Z S K=^PS(58.7,I,"DIV",J,"CL",Z,0) D:$P(K,"^",3)="Y"
  1. . S SA=$P(K,"^",2)
  1. . S:SA SA=$P($G(^PS(58.71,SA,0)),"^")
  1. . S PDCLA(I,J,+K)=DTP_$S(SA]"":"^"_SA,1:"")
  1. S Z=0
  1. F S Z=$O(^PS(58.7,I,"DIV",J,"PCG",Z)) Q:'Z D:$P($G(^PS(58.7,I,"DIV",J,"PCG",Z,2)),"^")="Y"
  1. . S SA=$P($G(^PS(58.7,I,"DIV",J,"PCG",Z,0)),"^",2)
  1. . S:SA SA=$P($G(^PS(58.71,SA,0)),"^")
  1. . S X=0 F S X=$O(^PS(58.7,I,"DIV",J,"PCG",Z,1,X)) Q:'X D
  1. .. S K=+$G(^PS(58.7,I,"DIV",J,"PCG",Z,1,X,0))
  1. .. I '$D(PDCLA(I,J,K)) S PDCLA(I,J,K)=DTP_$S(SA]"":"^"_SA,1:"")
  1. S Z=0
  1. F S Z=$O(^PS(58.7,I,"DIV",J,"VCG",Z)) Q:'Z S X=^PS(58.7,I,"DIV",J,"VCG",Z,0) D:$P(X,"^",3)="Y"
  1. . S SA=$P(X,"^",2) S:SA SA=$P($G(^PS(58.71,SA,0)),"^")
  1. . S Y=0 F S Y=$O(^PS(57.8,+X,1,Y)) Q:'Y D
  1. .. S K=+^(Y,0) S:'$D(PDCLA(I,J,K)) PDCLA(I,J,K)=DTP_$S(SA]"":"^"_SA,1:"")
  1. S Z=0,L=""
  1. F S Z=$O(^PS(58.7,I,"DIV",J,"WCN",Z)) Q:'Z S X=^PS(58.7,I,"DIV",J,"WCN",Z,0) D:$P(X,"^",3)="Y"
  1. . S SA=$P(X,"^",2) S:SA SA=$P($G(^PS(58.71,SA,0)),"^")
  1. . S Y=$P(X,"^"),P=$E(X,1,$L(Y)-1) F S P=$O(^SC("B",P)) Q:P="" D
  1. .. Q:($E(P,1,$L(Y))'=Y) ;p415
  1. .. S K=$O(^SC("B",P,0)),L=$G(^SC(K,0)) Q:$P(L,"^",3)'="C" Q:$P(L,"^",15)'=J
  1. .. S:'$D(PDCLA(I,J,K)) PDCLA(I,J,K)=DTP_$S(SA]"":"^"_SA,1:"")
  1. Q
  1. ;
  1. PV19 ;
  1. N NC,NDFN,NCLI,N19,NSA,NS,NWDI,NQ
  1. S (NSA,N19)="",(NQ,NC)=0,NS=$E(HL("ECH"),1),PDL(10)=XX,PDL(4)=HL("ETN")
  1. S:ZZ2]"" (NSA,PDL(12))=$O(^PS(58.71,"B",ZZ2,0))
  1. S:ZZ1]"" PDL(11)=$O(^PS(58.71,"B",ZZ1,""))
  1. F S NC=$O(NSEG(NC)) Q:'NC D Q:NQ
  1. . I $E(NSEG(NC),1,3)="PID" S (NDFN,PDL(1))=+$P(NSEG(NC),HL("FS"),4) Q
  1. . I $E(NSEG(NC),1,3)="PV1" D S NQ=1 Q
  1. .. I $P(NSEG(NC),HL("FS"),12)]"" D
  1. ... S NCLI=$P($P(NSEG(NC),HL("FS"),12),NS,2)
  1. ... S:'NCLI NCLI=$O(^SC("B",$P($P(NSEG(NC),HL("FS"),12),NS),0))
  1. ... S:NCLI PDL(5)=+$P($G(^SC(NCLI,0)),"^",15)
  1. ... S N19=NDFN_"-"_$S(NSA]"":NSA_"S",1:NCLI),PDL(9)=N19 S:NCLI PDL(8)=NCLI
  1. ... S $P(NSEG(NC),HL("FS"),20)=N19
  1. .. I $P(NSEG(NC),HL("FS"),4)]"" D
  1. ... S NWDI=$O(^DIC(42,"B",$P($P(NSEG(NC),HL("FS"),4),NS),0))
  1. ... I NWDI S PDL(7)=NWDI S:'$G(PDL(5)) PDL(5)=+$P($G(^DIC(42,NWDI,0)),"^",11)
  1. .. S:$P(NSEG(NC),HL("FS"),51)]"" PDL(6)=$P(NSEG(NC),HL("FS"),51)
  1. Q
  1. ;
  1. GETPSARS(PSYSIN,DFNIN,FILTER) ; Return Send Area for all clinic orders for patient DFN
  1. ; OUTPUT: ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"CL",CLINICIEN,SENDAREAIEN)=PCLSAS
  1. ; ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"SA",SENDAREAIEN,CLINICIEN)=PCLSAS
  1. ; PCLSAS=Send Area Name^PADE System^Division^Clinic Name^Source of Send Area value
  1. ; INPUT
  1. ; PSYSIN (required) - PADE System IEN from File #58.7
  1. ; FILTER (optional) - 0: No filter
  1. ; 1: INCLUDE CLINIC IN BG JOB required (set to YES).
  1. ; 2: RE-SEND ORDERS AT CHECK-IN required (set to YES)
  1. ; 3: Both INCLUDE CLINIC IN BG JOB and RE-SEND ORDERS AT CHECK-IN required (set to YES)
  1. ;
  1. Q:'$G(PSYSIN)
  1. N ND,CLIN,DFN,DIVISION
  1. S FILTER=+$G(FILTER)
  1. ;
  1. K ^TMP("PS",$J),^TMP($J,"PSJCLSA") S CNT=0
  1. S DFN=DFNIN
  1. D OCL1^PSJORRE(DFN,"","",0)
  1. Q:'$D(^TMP("PS",$J))
  1. ;
  1. N PSJORD,CLINICA
  1. S I=0 F S I=$O(^TMP("PS",$J,I)) Q:'I D
  1. . N CLINICI,IENS
  1. . S J=^TMP("PS",$J,I,0),PSJORD=$P(J,"^")
  1. . Q:'((PSJORD["U"!(PSJORD["V")&($P(J,"^",9)="ACTIVE")))
  1. . S IENS=+PSJORD_","_+DFN
  1. . I PSJORD["U" S CLINICI=$$GET1^DIQ(55.06,IENS,130,"I")
  1. . I PSJORD["V" S CLINICI=$$GET1^DIQ(55.01,IENS,136,"I")
  1. . Q:'$G(CLINICI)
  1. . S DIVISION=$$GET1^DIQ(44,CLINICI,3.5,"I")
  1. . Q:'$G(DIVISION)
  1. . S CLINICA(DIVISION,CLINICI)=""
  1. Q:'$O(CLINICA(""))
  1. ;
  1. S DIVISION=0 F S DIVISION=$O(CLINICA(DIVISION)) Q:'DIVISION D
  1. . S CLINICA=0 F S CLINICA=$O(CLINICA(DIVISION,CLINICA)) Q:'CLINICA D TMPSA(PSYSIN,DIVISION,CLINICA,FILTER)
  1. ;
  1. Q
  1. GETDSARS(PSYSIN,PDIVIN,FILTER) ; Return Send Area for all clinics in Division PDIVIN
  1. ; OUTPUT: ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"CL",CLINICIEN,SENDAREAIEN)=PCLSAS
  1. ; ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"SA",SENDAREAIEN,CLINICIEN)=PCLSAS
  1. ; PCLSAS=Send Area Name^PADE System^Division^Clinic Name^Source of Send Area value
  1. ; INPUT
  1. ; PSYSIN (required) - PADE System IEN from File #58.7
  1. ; PDIVIN (required) - PADE Division from File #58.7
  1. ; FILTER (optional) - 0: No filter
  1. ; 1: INCLUDE CLINIC IN BG JOB required (set to YES).
  1. ; 2: RE-SEND ORDERS AT CHECK-IN required (set to YES)
  1. ; 3: Both INCLUDE CLINIC IN BG JOB and RE-SEND ORDERS AT CHECK-IN required (set to YES)
  1. ;
  1. Q:'$G(PSYSIN)!'$G(PDIVIN)
  1. N ND,CLIN
  1. S FILTER=+$G(FILTER)
  1. ;
  1. S CLIN=0 F S CLIN=$O(^SC(CLIN)) Q:'CLIN D
  1. . D TMPSA(PSYSIN,PDIVIN,CLIN,FILTER)
  1. Q
  1. ;
  1. TMPSA(PSYSIN,PDIVIN,CLIN,FILTER) ; Build ^TMP( for clinic CLIN
  1. N PCLSAS
  1. S ND=^SC(CLIN,0) Q:$P(ND,"^",3)'="C" Q:$P(ND,"^",15)'=PDIVIN ; Different Division
  1. I $D(^SC(CLIN,"I")) S X=$G(^SC(CLIN,"I")) I $P(X,"^"),$P(X,"^",2)'>$P(X,"^") Q ; Inactive Clinic
  1. S PCLSAS=$$GETSAR(PSYSIN,PDIVIN,CLIN,FILTER)
  1. I $L($P(PCLSAS,"^"))>1 S PCLSAS(PSYSIN,PDIVIN,CLIN)=PCLSAS D
  1. . N SNDAREA,SNDAREAI S SNDAREA=$P(PCLSAS,"^"),SNDAREAI=$P(PCLSAS,"^",6)
  1. . S ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"CL",CLIN,SNDAREAI)=PCLSAS
  1. . S ^TMP($J,"PSJCLSA",PSYSIN,PDIVIN,"SA",SNDAREAI,CLIN)=PCLSAS
  1. Q
  1. ;
  1. GETSAR(PSYSIN,PDIVIN,PCLININ,FILTER) ; Return Send Area for clinic PCLIN
  1. ; PSYS - PADE system from PADE SYSTEM SETUP (#58.7)
  1. ; PDIV - Division from PADE SYSTEM SETUP (#58.7) (pointer to MEDICAL CENTER DIVISION #40.8)
  1. ; PSNDAR - Send Area from PADE SYSTEM SETUP (58.7) associated with the lowest (most specific/granular) clinic parameter
  1. ;
  1. I '$G(PSYSIN)!'$G(PDIVIN)!'$G(PCLININ) Q 0
  1. N PSJSAR,PSJSARI,PSJQ,PCLINAM,PSADIVDF,PSADIVDFI,PSJRESND,PSJBGJOB,PSJRESNDD,PSJBGJOBD,PSJNORES
  1. N PSJPSARI
  1. ;
  1. S PSJQ="" ; Return values
  1. S PSADIVDF="" ; Default Divisional Send Area Name
  1. S PSADIVDFI="" ; Default Divisional Send Area IEN
  1. S PSJRESND="" ; RE-SEND ORDERS AT CHECK-IN flag for clinic/clinic group
  1. S PSJRESNDD="" ; RE-SEND ORDERS AT CHECK-IN Divisional default (or System default if Div is null)
  1. S PSJBGJOB="" ; INCLUDE CLINIC IN BG JOB flag for clinic/clinic group
  1. S PSJBGJOBD="" ; INCLUDE CLINIC IN BG JOB flag Divisional default (or System default if Div is null)
  1. ;
  1. S PCLINAM=$P($G(^SC(+PCLININ,0)),"^")
  1. ;
  1. N DN S DN=$G(^PS(58.7,PSYSIN,"DIV",PDIVIN,0)) Q:DN="" 0
  1. N DC S DC=$P(DN,"^",2)
  1. I DC&(DC<DT) Q 0 ;DIV INACTIVE
  1. ;
  1. ; RE-SEND ORDERS AT CHECK-IN (default - if not defined at lower level)
  1. S PSJRESNDD=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,0)),"^",10)
  1. I PSJRESNDD="" S PSJRESNDD=$P($G(^PS(58.7,PSYSIN,1)),"^",3)
  1. ;
  1. ; INCLUDE ALL CLINICS IN BG JOB? (default - if not defined at lower level)
  1. S PSJBGJOBD=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,0)),"^",9)
  1. S PSJBGJOBD=$S(PSJBGJOBD="Y":1,PSJBGJOBD="N":0,1:"")
  1. ;
  1. ; Get Divisional/System default Send Area if not filtered
  1. I ($P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,0)),"^",3)="Y")&($P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,2)),"^",1)="Y") D
  1. . S PSADIVDFI=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,0)),"^",4)
  1. . S:PSADIVDFI PSADIVDF=$P($G(^PS(58.71,PSADIVDFI,0)),"^")
  1. ;
  1. ; Get CLINIC default Send Area if not filtered
  1. S PSJSARI=$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"CL","B",PCLININ,0))
  1. I PSJSARI D
  1. . I ($G(FILTER)=2)!($G(FILTER)=3) D Q:'$G(PSJRESND)
  1. .. S PSJRESND=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"CL",PSJSARI,0)),"^",4)
  1. .. S:PSJRESND="" PSJRESND=PSJRESNDD
  1. . I ($G(FILTER)=1)!($G(FILTER)=3) D Q:'$G(PSJBGJOB)
  1. .. S PSJBGJOB=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"CL",PSJSARI,0)),"^",3)
  1. .. S PSJBGJOB=$S(PSJBGJOB="Y":1,1:PSJBGJOBD) ; Choices=YES or NULL
  1. .. S:PSJBGJOB PSJBGJOBD=PSJBGJOB ; If INCLUDE=YES, use as default for this clinic (can't be overridden)
  1. . S PSJSARI=+$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"CL",PSJSARI,0)),"^",2)
  1. . S PSJSAR=$P($G(^PS(58.71,+PSJSARI,0)),"^")
  1. . S PSJQ=PSJSAR_"^"_PSYSIN_"^"_PDIVIN_"^"_PCLINAM_"^CL^"_PSJSARI
  1. Q:$L(PSJQ) PSJQ
  1. Q:(PSJRESND=0) "" ; RE-SEND ORDERS=NO for this clinic, filter=required, ignore higher Send Area values.
  1. ;
  1. ; Get PADE CLINIC GROUP Send Area if not filtered
  1. S PSJSARI=$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"PCG","C",PCLININ,0))
  1. I PSJSARI D
  1. . I ($G(FILTER)=2)!($G(FILTER)=3) D Q:'$G(PSJRESND)
  1. .. S PSJRESND=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"PCG",PSJSARI,2)),"^",2)
  1. .. S:PSJRESND="" PSJRESND=PSJRESNDD
  1. . I ($G(FILTER)=1)!($G(FILTER)=3) D Q:'$G(PSJBGJOB)
  1. .. S PSJBGJOB=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"PCG",PSJSARI,2)),"^")
  1. .. S PSJBGJOB=$S(PSJBGJOB="Y":1,1:PSJBGJOBD) ; Choices=YES or NULL
  1. .. S:PSJBGJOB PSJBGJOBD=PSJBGJOB ; If INCLUDE=YES, use as default for this clinic (can't be overridden)
  1. . S PSJSARI=+$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"PCG",PSJSARI,0)),"^",2)
  1. . S PSJSAR=$P($G(^PS(58.71,+PSJSARI,0)),"^")
  1. . S PSJQ=PSJSAR_"^"_PSYSIN_"^"_PDIVIN_"^"_PCLINAM_"^PCG^"_PSJSARI
  1. Q:$L(PSJQ) PSJQ
  1. Q:(PSJRESND=0) "" ; RE-SEND ORDERS=NO for this clinic, filter=required, ignore higher Send Area values.
  1. ;
  1. ; Get VISTA CLINIC GROUP Send Area if not filtered
  1. I $O(^PS(57.8,"AC",PCLININ,0)) D
  1. . S PSJSARI=$O(^PS(57.8,"AC",PCLININ,0))
  1. . I PSJSARI S PSJSARI=$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"VCG","B",PSJSARI,0))
  1. . Q:'PSJSARI
  1. . I ($G(FILTER)=2)!($G(FILTER)=3) D Q:'$G(PSJRESND)
  1. .. S PSJRESND=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"VCG",PSJSARI,0)),"^",4)
  1. .. S:PSJRESND="" PSJRESND=PSJRESNDD
  1. . I ($G(FILTER)=1)!($G(FILTER)=3) D Q:'$G(PSJBGJOB)
  1. .. S PSJBGJOB=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"VCG",PSJSARI,0)),"^",3)
  1. .. S PSJBGJOB=$S(PSJBGJOB="Y":1,1:PSJBGJOBD) ; Choices=YES or NULL
  1. .. S:PSJBGJOB PSJBGJOBD=PSJBGJOB ; If INCLUDE=YES, use as default for this clinic (can't be overridden)
  1. . S PSJSARI=+$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"VCG",PSJSARI,0)),"^",2)
  1. . S PSJSAR=$P($G(^PS(58.71,PSJSARI,0)),"^")
  1. . S PSJQ=PSJSAR_"^"_PSYSIN_"^"_PDIVIN_"^"_PCLINAM_"^VCG^"_PSJSARI
  1. Q:$L(PSJQ) PSJQ
  1. Q:(PSJRESND=0) "" ; RE-SEND ORDERS=NO for this clinic, filter=required, ignore higher Send Area values.
  1. ;
  1. ; Get WILDCARD CLINIC NAME Send Area if not filtered
  1. S PSJPSARI=$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN","B",0)) I PSJPSARI'="" D
  1. . N PSJWC,PSJLEN S PSJWC="" F S PSJWC=$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN","B",PSJWC)) Q:PSJWC="" D
  1. .. I $E(PCLINAM,1,$L(PSJWC))=PSJWC S PSJLEN($L(PSJWC),PSJWC)=""
  1. . I $D(PSJLEN) D
  1. .. S PSJPSARI=$O(PSJLEN(999),-1)
  1. .. S PSJPSARI=$O(PSJLEN(PSJPSARI,0))
  1. .. S PSJPSARI=+$O(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN","B",PSJPSARI,0))
  1. .. S PSJSARI=+$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN",PSJPSARI,0)),"^",2)
  1. .. S PSJSAR=$P($G(^PS(58.71,PSJSARI,0)),"^")
  1. . I ($G(FILTER)=2)!($G(FILTER)=3) D Q:'$G(PSJRESND)
  1. .. S PSJRESND=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN",PSJPSARI,0)),"^",4)
  1. .. S:PSJRESND="" PSJRESND=PSJRESNDD
  1. . I ($G(FILTER)=1)!($G(FILTER)=3) D Q:'$G(PSJBGJOB)
  1. .. S PSJBGJOB=$P($G(^PS(58.7,PSYSIN,"DIV",PDIVIN,"WCN",PSJPSARI,0)),"^",3)
  1. .. S PSJBGJOB=$S(PSJBGJOB="Y":1,1:PSJBGJOBD) ; Choices=YES or NULL
  1. .. S:PSJBGJOB PSJBGJOBD=PSJBGJOB ; If INCLUDE=YES, use as default for this clinic (can't be overridden)
  1. . S PSJQ=$G(PSJSAR)_"^"_PSYSIN_"^"_PDIVIN_"^"_PCLINAM_"^WCN^"_PSJSARI
  1. Q:$L(PSJQ) PSJQ
  1. Q:(PSJRESND=0) "" ; RE-SEND ORDERS=NO for this clinic, filter=required, ignore higher Send Area values.
  1. ;
  1. ; If no matches, use Division default. PSADIVDF only defined if SEND MESSAGES FOR ALL CLINICS? and SEND ORDER MESSAGES? set to YES
  1. ; and Divisional default SEND AREA exists.
  1. I $L($G(PSADIVDF)) D
  1. . I ($G(FILTER)=2)!($G(FILTER)=3) Q:'$G(PSJRESNDD)
  1. . I ($G(FILTER)=1)!($G(FILTER)=3) Q:'$G(PSJBGJOBD)
  1. . S PSJQ=PSADIVDF_"^"_PSYSIN_"^"_PDIVIN_"^"_PCLINAM_"^DIVDFLT^"_PSADIVDFI
  1. Q PSJQ
  1. ;
  1. KILLTMP ; Clean up ^TMP($J,"PSJCLSA")
  1. K ^TMP($J,"PSJCLSA")
  1. Q