PXRMXAP ; SLC/PJH - Reminder Reports APIs;07/29/2004
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
; Called from PXRMSU
;
FACT ;Check PCMM Team ^SCTM(404.51 for facility ; DBIA #2795
S DIC("S")=DIC("S")_",$D(PXRMFACN(+$P(^(0),U,7)))"
Q
;
LOCN(ARRAY) ;Check for mixed inpatient/outpatient locations ; DBIA #10040
N IC,IEN,MIXED,TYPE
S IC=0,MIXED=0,TYPE=0
F S IC=$O(ARRAY(IC)) Q:IC="" D Q:MIXED
.S IEN=$P(ARRAY(IC),U,2) Q:IEN=""
.I TYPE=0,$D(^SC(IEN,42)) S TYPE="INPATIENT" Q
.I TYPE=0,'$D(^SC(IEN,42)) S TYPE="OUTPATIENT" Q
.I TYPE="INPATIENT",'$D(^SC(IEN,42)) S MIXED=1 Q
.I TYPE="OUTPATIENT",$D(^SC(IEN,42)) S MIXED=1 Q
Q MIXED
;
; Called from PXRMSEO
;
FAC(TIEN) ; Get Facility for the PCMM Team ; DBIA #2795
Q $P($G(^SCTM(404.51,TIEN,0)),U,7)
;
PCASSIGN(DFN) ; Assigned to Provider as Primary Care ; DBIA #1916
N PCVAR,PC S PC=0
S PCVAR=$$OUTPTPR^SDUTL3(DFN)
I PCVAR]"" S:$P(PCVAR,U)=PCM PC=1
Q PC
;
PTTM(TIEN,SCERR) ; Build list of Teams Patients ; DBIA #1916
Q $$PTTM^SCAPMC(TIEN,"SCDT","^TMP($J,""PCM"")",.SCERR)
;
PTPR(PIEN,PXRMREP) ; Build list of practitioners patients ; DBIA #1916
N SCERRD,OK
S OK=$$PTPR^SCAPMC(PIEN,"SCDT","","","^TMP($J,""PCM"")",.SCERRD)
;
; Determine Associated Clinic from Team Position/Team Position Assign
I PXRMREP="D" D
.N SUB,SCTP,SCTPA,DCLN
.S SUB=0
.F S SUB=$O(^TMP($J,"PCM",SUB)) Q:'SUB D
..S SCTP=$P(^TMP($J,"PCM",SUB),U,3) Q:SCTP=""
..S SCTPA=$P($G(^SCPT(404.43,SCTP,0)),U,2) Q:SCTPA="" ; DBIA #2811
..S DCLN=$P($G(^SCTM(404.57,SCTPA,0)),U,9) ; DBIA #2810
..S $P(^TMP($J,"PCM",SUB),U,7)=DCLN
Q
;
; Called from PXRMXD/PXRMYD
;
INP(INP,PXRMLOCN) ;
;If selected locations check for wards ; DBIA #10040
N LOC,WARD
S LOC="",WARD=0
; All locations must be wards for the prompt to display
F S LOC=$O(PXRMLOCN(LOC)) Q:LOC="" D Q:'WARD
.S WARD=0 I $D(^SC(LOC,42)) S WARD=1
Q WARD
;
; Called from PXRMXSEL/PXRMYSEL
;
FACL(LOCIEN) ; Get locations facility ; DBIA #2804
N DIV
I $P($G(^SC(LOCIEN,0)),U,4)'="" Q $P($G(^SC(LOCIEN,0)),U,4)
S DIV=$P($G(^SC(LOCIEN,0)),U,15) Q:DIV="" ""
Q $P($G(^DG(40.8,DIV,0)),U,7)
;
WARD(LOCIEN,ARRAY) ;Get list of patients if location is a ward ;DBIA #10035
N WARDIEN,WARDNAM,DFN
S WARDIEN=$G(^SC(LOCIEN,42)) Q:WARDIEN=""
S WARDNAM=$P($G(^DIC(42,WARDIEN,0)),U) Q:WARDNAM=""
S DFN=""
F S DFN=$O(^DPT("CN",WARDNAM,DFN)) Q:DFN="" S ARRAY(DFN)=""
Q
;
ADM(LOCIEN,ARRAY,BD,ED) ;Get list of admissions to ward ; DBIA #10040,1480
N WARDIEN,DA,DATA,DFN
S WARDIEN=$G(^SC(LOCIEN,42)) Q:WARDIEN=""
F S BD=$O(^DGPM("ATT1",BD)) Q:BD>ED Q:BD="" D
.S DA=""
.F S DA=$O(^DGPM("ATT1",BD,DA)) Q:DA="" D
..S DATA=$G(^DGPM(DA,0)) Q:DATA=""
..I $P(DATA,U,6)'=WARDIEN Q
..S DFN=$P(DATA,U,3) Q:DFN=""
..S ARRAY(DFN)=""
Q
;
LCHL(INP,ARRAY) ;Get list of all inpatient or outpatient locations ; DBIA #10040
N HLOCIEN,NAME,IC
S HLOCIEN=0,IC=0
F S HLOCIEN=$O(^SC(HLOCIEN)) Q:'HLOCIEN D
.;Outpatient report ignores wards - HA
.I INP=0,$D(^SC(HLOCIEN,42)) Q
.;Inpatient report includes only wards - HAI
.I INP=1,'$D(^SC(HLOCIEN,42)) Q
.S NAME=$P($G(^SC(HLOCIEN,0)),U) I NAME="" Q
.;Build array
.S IC=IC+1,PXRMLCHL(IC)=NAME_U_HLOCIEN,PXRMLOCN(HLOCIEN)=IC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXAP 3288 printed Oct 16, 2024@17:50:56 Page 2
PXRMXAP ; SLC/PJH - Reminder Reports APIs;07/29/2004
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ; Called from PXRMSU
+4 ;
FACT ;Check PCMM Team ^SCTM(404.51 for facility ; DBIA #2795
+1 SET DIC("S")=DIC("S")_",$D(PXRMFACN(+$P(^(0),U,7)))"
+2 QUIT
+3 ;
LOCN(ARRAY) ;Check for mixed inpatient/outpatient locations ; DBIA #10040
+1 NEW IC,IEN,MIXED,TYPE
+2 SET IC=0
SET MIXED=0
SET TYPE=0
+3 FOR
SET IC=$ORDER(ARRAY(IC))
if IC=""
QUIT
Begin DoDot:1
+4 SET IEN=$PIECE(ARRAY(IC),U,2)
if IEN=""
QUIT
+5 IF TYPE=0
IF $DATA(^SC(IEN,42))
SET TYPE="INPATIENT"
QUIT
+6 IF TYPE=0
IF '$DATA(^SC(IEN,42))
SET TYPE="OUTPATIENT"
QUIT
+7 IF TYPE="INPATIENT"
IF '$DATA(^SC(IEN,42))
SET MIXED=1
QUIT
+8 IF TYPE="OUTPATIENT"
IF $DATA(^SC(IEN,42))
SET MIXED=1
QUIT
End DoDot:1
if MIXED
QUIT
+9 QUIT MIXED
+10 ;
+11 ; Called from PXRMSEO
+12 ;
FAC(TIEN) ; Get Facility for the PCMM Team ; DBIA #2795
+1 QUIT $PIECE($GET(^SCTM(404.51,TIEN,0)),U,7)
+2 ;
PCASSIGN(DFN) ; Assigned to Provider as Primary Care ; DBIA #1916
+1 NEW PCVAR,PC
SET PC=0
+2 SET PCVAR=$$OUTPTPR^SDUTL3(DFN)
+3 IF PCVAR]""
if $PIECE(PCVAR,U)=PCM
SET PC=1
+4 QUIT PC
+5 ;
PTTM(TIEN,SCERR) ; Build list of Teams Patients ; DBIA #1916
+1 QUIT $$PTTM^SCAPMC(TIEN,"SCDT","^TMP($J,""PCM"")",.SCERR)
+2 ;
PTPR(PIEN,PXRMREP) ; Build list of practitioners patients ; DBIA #1916
+1 NEW SCERRD,OK
+2 SET OK=$$PTPR^SCAPMC(PIEN,"SCDT","","","^TMP($J,""PCM"")",.SCERRD)
+3 ;
+4 ; Determine Associated Clinic from Team Position/Team Position Assign
+5 IF PXRMREP="D"
Begin DoDot:1
+6 NEW SUB,SCTP,SCTPA,DCLN
+7 SET SUB=0
+8 FOR
SET SUB=$ORDER(^TMP($JOB,"PCM",SUB))
if 'SUB
QUIT
Begin DoDot:2
+9 SET SCTP=$PIECE(^TMP($JOB,"PCM",SUB),U,3)
if SCTP=""
QUIT
+10 ; DBIA #2811
SET SCTPA=$PIECE($GET(^SCPT(404.43,SCTP,0)),U,2)
if SCTPA=""
QUIT
+11 ; DBIA #2810
SET DCLN=$PIECE($GET(^SCTM(404.57,SCTPA,0)),U,9)
+12 SET $PIECE(^TMP($JOB,"PCM",SUB),U,7)=DCLN
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
+15 ; Called from PXRMXD/PXRMYD
+16 ;
INP(INP,PXRMLOCN) ;
+1 ;If selected locations check for wards ; DBIA #10040
+2 NEW LOC,WARD
+3 SET LOC=""
SET WARD=0
+4 ; All locations must be wards for the prompt to display
+5 FOR
SET LOC=$ORDER(PXRMLOCN(LOC))
if LOC=""
QUIT
Begin DoDot:1
+6 SET WARD=0
IF $DATA(^SC(LOC,42))
SET WARD=1
End DoDot:1
if 'WARD
QUIT
+7 QUIT WARD
+8 ;
+9 ; Called from PXRMXSEL/PXRMYSEL
+10 ;
FACL(LOCIEN) ; Get locations facility ; DBIA #2804
+1 NEW DIV
+2 IF $PIECE($GET(^SC(LOCIEN,0)),U,4)'=""
QUIT $PIECE($GET(^SC(LOCIEN,0)),U,4)
+3 SET DIV=$PIECE($GET(^SC(LOCIEN,0)),U,15)
if DIV=""
QUIT ""
+4 QUIT $PIECE($GET(^DG(40.8,DIV,0)),U,7)
+5 ;
WARD(LOCIEN,ARRAY) ;Get list of patients if location is a ward ;DBIA #10035
+1 NEW WARDIEN,WARDNAM,DFN
+2 SET WARDIEN=$GET(^SC(LOCIEN,42))
if WARDIEN=""
QUIT
+3 SET WARDNAM=$PIECE($GET(^DIC(42,WARDIEN,0)),U)
if WARDNAM=""
QUIT
+4 SET DFN=""
+5 FOR
SET DFN=$ORDER(^DPT("CN",WARDNAM,DFN))
if DFN=""
QUIT
SET ARRAY(DFN)=""
+6 QUIT
+7 ;
ADM(LOCIEN,ARRAY,BD,ED) ;Get list of admissions to ward ; DBIA #10040,1480
+1 NEW WARDIEN,DA,DATA,DFN
+2 SET WARDIEN=$GET(^SC(LOCIEN,42))
if WARDIEN=""
QUIT
+3 FOR
SET BD=$ORDER(^DGPM("ATT1",BD))
if BD>ED
QUIT
if BD=""
QUIT
Begin DoDot:1
+4 SET DA=""
+5 FOR
SET DA=$ORDER(^DGPM("ATT1",BD,DA))
if DA=""
QUIT
Begin DoDot:2
+6 SET DATA=$GET(^DGPM(DA,0))
if DATA=""
QUIT
+7 IF $PIECE(DATA,U,6)'=WARDIEN
QUIT
+8 SET DFN=$PIECE(DATA,U,3)
if DFN=""
QUIT
+9 SET ARRAY(DFN)=""
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
LCHL(INP,ARRAY) ;Get list of all inpatient or outpatient locations ; DBIA #10040
+1 NEW HLOCIEN,NAME,IC
+2 SET HLOCIEN=0
SET IC=0
+3 FOR
SET HLOCIEN=$ORDER(^SC(HLOCIEN))
if 'HLOCIEN
QUIT
Begin DoDot:1
+4 ;Outpatient report ignores wards - HA
+5 IF INP=0
IF $DATA(^SC(HLOCIEN,42))
QUIT
+6 ;Inpatient report includes only wards - HAI
+7 IF INP=1
IF '$DATA(^SC(HLOCIEN,42))
QUIT
+8 SET NAME=$PIECE($GET(^SC(HLOCIEN,0)),U)
IF NAME=""
QUIT
+9 ;Build array
+10 SET IC=IC+1
SET PXRMLCHL(IC)=NAME_U_HLOCIEN
SET PXRMLOCN(HLOCIEN)=IC
End DoDot:1
+11 QUIT
