- EDPFPER ;SLC/KCM - Lookup Persons at Facility ;2/28/12 08:33am
- ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
- ;
- MATCH(MATCH,PTYP) ; Return a matching list of providers
- S MATCH=$$UP^XLFSTR(MATCH)
- S MATCH=$TR(MATCH,"_"," ") ; underscore replaces space in flex widget
- D XML^EDPX("<personType>"_PTYP_"</personType>")
- I PTYP="C" D CLERK Q
- I PTYP="N" D NURS Q
- I "PR"[PTYP D PROV Q
- Q
- PROV ; match providers
- N NM,PRV
- S NM=$O(^VA(200,"AK.PROVIDER",MATCH),-1)
- F S NM=$O(^VA(200,"AK.PROVIDER",NM)) Q:$E(NM,1,$L(MATCH))'=MATCH D
- . S PRV=0 F S PRV=$O(^VA(200,"AK.PROVIDER",NM,PRV)) Q:'PRV D
- .. I $$ALLOW(PRV,"P") D ADD(PRV,NM)
- Q
- NURS ; match nurses
- N NM,NRS,EDPNURS
- S EDPNURS=$$GET^XPAR("ALL","EDPF NURSE STAFF SCREEN")
- S NM=$O(^VA(200,"B",MATCH),-1)
- F S NM=$O(^VA(200,"B",NM)) Q:$E(NM,1,$L(MATCH))'=MATCH D
- . S NRS=0 F S NRS=$O(^VA(200,"B",NM,NRS)) Q:'NRS D
- .. I $$ALLOW(NRS,"N") D ADD(NRS,NM)
- Q
- CLERK ;
- N NM,CLRK
- S NM=$O(^VA(200,"B",MATCH),-1)
- F S NM=$O(^VA(200,"B",NM)) Q:$E(NM,1,$L(MATCH))'=MATCH D
- .S CLRK=0 F S CLRK=$O(^VA(200,"B",NM,CLRK)) Q:'CLRK D
- ..I $$ALLOW(CLRK,"C") D ADD(CLRK,NM)
- Q
- ADD(PER,NM) ; Add the person to the list of staff
- N X,X0,TITLE
- S X0=^VA(200,PER,0),TITLE=$P(X0,U,9)
- S X("nm")=NM
- S X("itl")=$P(X0,U,2)
- I X("itl")="" S X("itl")=$E($P(NM,",",2))_$E(NM)
- S X("duz")=PER
- I TITLE S X("title")=$P($G(^DIC(3.1,TITLE,0)),U)
- D XML^EDPX($$XMLA^EDPX("staff",.X))
- Q
- ALLOW(PER,ROLE) ; Screen when selecting persons
- ; PER is IEN for file 200, ROLE is P(rovider),R(esident), or N(urse)
- ; Expects EDPNURS to be defined for nurses (EDPF NURSE STAFF FILTER)
- I '$$ACTIVE^XUSER(PER) Q 0
- I ("PR"[ROLE),'$$PROVIDER^XUSER(PER) Q 0
- Q:ROLE'="N" 1
- ;
- I '$G(EDPNURS),'$D(^NURSF(210,"B",PER)) Q 0
- I ($G(EDPNURS)=1),'$D(^XUSEC("ORELSE",PER)) Q 0
- I ($G(EDPNURS)=2),'$D(^XUSEC("PSJ RNURSE",PER)) Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPFPER 1910 printed Feb 18, 2025@23:18:16 Page 2
- EDPFPER ;SLC/KCM - Lookup Persons at Facility ;2/28/12 08:33am
- +1 ;;2.0;EMERGENCY DEPARTMENT;**6**;Feb 24, 2012;Build 200
- +2 ;
- MATCH(MATCH,PTYP) ; Return a matching list of providers
- +1 SET MATCH=$$UP^XLFSTR(MATCH)
- +2 ; underscore replaces space in flex widget
- SET MATCH=$TRANSLATE(MATCH,"_"," ")
- +3 DO XML^EDPX("<personType>"_PTYP_"</personType>")
- +4 IF PTYP="C"
- DO CLERK
- QUIT
- +5 IF PTYP="N"
- DO NURS
- QUIT
- +6 IF "PR"[PTYP
- DO PROV
- QUIT
- +7 QUIT
- PROV ; match providers
- +1 NEW NM,PRV
- +2 SET NM=$ORDER(^VA(200,"AK.PROVIDER",MATCH),-1)
- +3 FOR
- SET NM=$ORDER(^VA(200,"AK.PROVIDER",NM))
- if $EXTRACT(NM,1,$LENGTH(MATCH))'=MATCH
- QUIT
- Begin DoDot:1
- +4 SET PRV=0
- FOR
- SET PRV=$ORDER(^VA(200,"AK.PROVIDER",NM,PRV))
- if 'PRV
- QUIT
- Begin DoDot:2
- +5 IF $$ALLOW(PRV,"P")
- DO ADD(PRV,NM)
- End DoDot:2
- End DoDot:1
- +6 QUIT
- NURS ; match nurses
- +1 NEW NM,NRS,EDPNURS
- +2 SET EDPNURS=$$GET^XPAR("ALL","EDPF NURSE STAFF SCREEN")
- +3 SET NM=$ORDER(^VA(200,"B",MATCH),-1)
- +4 FOR
- SET NM=$ORDER(^VA(200,"B",NM))
- if $EXTRACT(NM,1,$LENGTH(MATCH))'=MATCH
- QUIT
- Begin DoDot:1
- +5 SET NRS=0
- FOR
- SET NRS=$ORDER(^VA(200,"B",NM,NRS))
- if 'NRS
- QUIT
- Begin DoDot:2
- +6 IF $$ALLOW(NRS,"N")
- DO ADD(NRS,NM)
- End DoDot:2
- End DoDot:1
- +7 QUIT
- CLERK ;
- +1 NEW NM,CLRK
- +2 SET NM=$ORDER(^VA(200,"B",MATCH),-1)
- +3 FOR
- SET NM=$ORDER(^VA(200,"B",NM))
- if $EXTRACT(NM,1,$LENGTH(MATCH))'=MATCH
- QUIT
- Begin DoDot:1
- +4 SET CLRK=0
- FOR
- SET CLRK=$ORDER(^VA(200,"B",NM,CLRK))
- if 'CLRK
- QUIT
- Begin DoDot:2
- +5 IF $$ALLOW(CLRK,"C")
- DO ADD(CLRK,NM)
- End DoDot:2
- End DoDot:1
- +6 QUIT
- ADD(PER,NM) ; Add the person to the list of staff
- +1 NEW X,X0,TITLE
- +2 SET X0=^VA(200,PER,0)
- SET TITLE=$PIECE(X0,U,9)
- +3 SET X("nm")=NM
- +4 SET X("itl")=$PIECE(X0,U,2)
- +5 IF X("itl")=""
- SET X("itl")=$EXTRACT($PIECE(NM,",",2))_$EXTRACT(NM)
- +6 SET X("duz")=PER
- +7 IF TITLE
- SET X("title")=$PIECE($GET(^DIC(3.1,TITLE,0)),U)
- +8 DO XML^EDPX($$XMLA^EDPX("staff",.X))
- +9 QUIT
- ALLOW(PER,ROLE) ; Screen when selecting persons
- +1 ; PER is IEN for file 200, ROLE is P(rovider),R(esident), or N(urse)
- +2 ; Expects EDPNURS to be defined for nurses (EDPF NURSE STAFF FILTER)
- +3 IF '$$ACTIVE^XUSER(PER)
- QUIT 0
- +4 IF ("PR"[ROLE)
- IF '$$PROVIDER^XUSER(PER)
- QUIT 0
- +5 if ROLE'="N"
- QUIT 1
- +6 ;
- +7 IF '$GET(EDPNURS)
- IF '$DATA(^NURSF(210,"B",PER))
- QUIT 0
- +8 IF ($GET(EDPNURS)=1)
- IF '$DATA(^XUSEC("ORELSE",PER))
- QUIT 0
- +9 IF ($GET(EDPNURS)=2)
- IF '$DATA(^XUSEC("PSJ RNURSE",PER))
- QUIT 0
- +10 QUIT 1