PXRMAPI1 ; SLC/PJH - Reminder Package API's;02/27/2002
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;Return ARRAY ; DBIA #3333
;------------------------
PLIST(ORY) ;Build a list of patient list entries.
N CNT,PATCNT,DATE,IND,FULL,NAME
;Build the list in alphabetical order.
S CNT=0
S NAME=""
F S NAME=$O(^PXRMXP(810.5,"B",NAME)) Q:NAME="" D
.S IND=$O(^PXRMXP(810.5,"B",NAME,"")) Q:'IND
.S FULL=$P($G(^PXRMXP(810.5,IND,0)),U)
.S DATE=$P($G(^PXRMXP(810.5,IND,0)),U,4)
.S PATCNT=+$P($G(^PXRMXP(810.5,IND,30,0)),U,4),CNT=CNT+1
.S ORY(CNT)=IND_U_FULL_U_$$FMTE^XLFDT(DATE,"5Z")_U_PATCNT
I CNT=0 S ORY(1)="-1^no entries found"
Q
;
PLISTP(ORY,IEN) ;Build a list of patient list patients
N CNT,DATA,DFN,PNAME,IND,STATION,VADM,VAERR
;Build the list in alphabetical order.
S IND=0,CNT=0
F S IND=$O(^PXRMXP(810.5,IEN,30,IND)) Q:'IND D
.S DATA=$G(^PXRMXP(810.5,IEN,30,IND,0)) Q:DATA=""
.S DFN=$P(DATA,U) Q:'DFN
.D DEM^VADPT S PNAME=$G(VADM(1))
.S STATION=$P(DATA,U,2)
.S CNT=CNT+1,ORY(CNT)=DFN_U_PNAME_U_STATION
I CNT=0 S ORY(1)="-1^no entries found"
Q
;
EPLIST(ORY) ;Build a list of extract parameter entries.
N CNT,DATE,IND,FULL,NAME,TRANSMIT
;Build the list in alphabetical order.
S CNT=0
S NAME=""
F S NAME=$O(^PXRM(810.2,"B",NAME)) Q:NAME="" D
.S IND=$O(^PXRM(810.2,"B",NAME,"")) Q:'IND
.S FULL=$P($G(^PXRM(810.2,IND,0)),U)
.S DATE=$P($G(^PXRM(810.2,IND,0)),U,4)
.S TRANSMIT=""
.S CNT=CNT+1,ORY(CNT)=IND_U_FULL_U_DATE_U_TRANSMIT
I CNT=0 S ORY(1)="-1^no entries found"
Q
;
EHLIST(ORY,IEN) ;Build a list of extract summary entries.
N CNT,IND,NAME,PERIOD,YEAR
;Build the list in alphabetical order.
S YEAR="9999",CNT=0
F S YEAR=$O(^PXRMXT(810.3,"D",IEN,YEAR),-1) Q:'YEAR D
.S PERIOD=""
.F S PERIOD=$O(^PXRMXT(810.3,"D",IEN,YEAR,PERIOD)) Q:'PERIOD D
..S IND=""
..F S IND=$O(^PXRMXT(810.3,"D",IEN,YEAR,PERIOD,IND)) Q:'IND D
...S NAME=$P($G(^PXRMXT(810.3,IND,0)),U) Q:NAME=""
...S CNT=CNT+1,ORY(CNT)=IND_U_NAME
I CNT=0 S ORY(1)="-1^no entries found"
Q
;
ETLIST(ORY,IEN) ;Build a list of extract summary totals.
N APPL,CNT,DATA,DUE,IND,RIEN,RNAME,SNAME,STATION,TOT
;Build the list in alphabetical order.
S IND=0,CNT=0
F S IND=$O(^PXRMXT(810.3,IEN,3,IND)) Q:'IND D
.S DATA=$G(^PXRMXT(810.3,IEN,3,IND,0)) Q:DATA=""
.S RIEN=$P(DATA,U,2) Q:'RIEN
.S RNAME=$P($G(^PXD(811.9,RIEN,0)),U)
.S STATION=$P(DATA,U,3),SNAME=STATION
.S TOT=+$P(DATA,U,5),APPL=+$P(DATA,U,6),DUE=$P(DATA,U,8)
.S CNT=CNT+1,ORY(CNT)=RNAME_U_SNAME_U_TOT_U_APPL_U_DUE
I CNT=0 S ORY(1)="-1^no entries found"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMAPI1 2606 printed Apr 09, 2024@20:48 Page 2
PXRMAPI1 ; SLC/PJH - Reminder Package API's;02/27/2002
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;Return ARRAY ; DBIA #3333
+4 ;------------------------
PLIST(ORY) ;Build a list of patient list entries.
+1 NEW CNT,PATCNT,DATE,IND,FULL,NAME
+2 ;Build the list in alphabetical order.
+3 SET CNT=0
+4 SET NAME=""
+5 FOR
SET NAME=$ORDER(^PXRMXP(810.5,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET IND=$ORDER(^PXRMXP(810.5,"B",NAME,""))
if 'IND
QUIT
+7 SET FULL=$PIECE($GET(^PXRMXP(810.5,IND,0)),U)
+8 SET DATE=$PIECE($GET(^PXRMXP(810.5,IND,0)),U,4)
+9 SET PATCNT=+$PIECE($GET(^PXRMXP(810.5,IND,30,0)),U,4)
SET CNT=CNT+1
+10 SET ORY(CNT)=IND_U_FULL_U_$$FMTE^XLFDT(DATE,"5Z")_U_PATCNT
End DoDot:1
+11 IF CNT=0
SET ORY(1)="-1^no entries found"
+12 QUIT
+13 ;
PLISTP(ORY,IEN) ;Build a list of patient list patients
+1 NEW CNT,DATA,DFN,PNAME,IND,STATION,VADM,VAERR
+2 ;Build the list in alphabetical order.
+3 SET IND=0
SET CNT=0
+4 FOR
SET IND=$ORDER(^PXRMXP(810.5,IEN,30,IND))
if 'IND
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMXP(810.5,IEN,30,IND,0))
if DATA=""
QUIT
+6 SET DFN=$PIECE(DATA,U)
if 'DFN
QUIT
+7 DO DEM^VADPT
SET PNAME=$GET(VADM(1))
+8 SET STATION=$PIECE(DATA,U,2)
+9 SET CNT=CNT+1
SET ORY(CNT)=DFN_U_PNAME_U_STATION
End DoDot:1
+10 IF CNT=0
SET ORY(1)="-1^no entries found"
+11 QUIT
+12 ;
EPLIST(ORY) ;Build a list of extract parameter entries.
+1 NEW CNT,DATE,IND,FULL,NAME,TRANSMIT
+2 ;Build the list in alphabetical order.
+3 SET CNT=0
+4 SET NAME=""
+5 FOR
SET NAME=$ORDER(^PXRM(810.2,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+6 SET IND=$ORDER(^PXRM(810.2,"B",NAME,""))
if 'IND
QUIT
+7 SET FULL=$PIECE($GET(^PXRM(810.2,IND,0)),U)
+8 SET DATE=$PIECE($GET(^PXRM(810.2,IND,0)),U,4)
+9 SET TRANSMIT=""
+10 SET CNT=CNT+1
SET ORY(CNT)=IND_U_FULL_U_DATE_U_TRANSMIT
End DoDot:1
+11 IF CNT=0
SET ORY(1)="-1^no entries found"
+12 QUIT
+13 ;
EHLIST(ORY,IEN) ;Build a list of extract summary entries.
+1 NEW CNT,IND,NAME,PERIOD,YEAR
+2 ;Build the list in alphabetical order.
+3 SET YEAR="9999"
SET CNT=0
+4 FOR
SET YEAR=$ORDER(^PXRMXT(810.3,"D",IEN,YEAR),-1)
if 'YEAR
QUIT
Begin DoDot:1
+5 SET PERIOD=""
+6 FOR
SET PERIOD=$ORDER(^PXRMXT(810.3,"D",IEN,YEAR,PERIOD))
if 'PERIOD
QUIT
Begin DoDot:2
+7 SET IND=""
+8 FOR
SET IND=$ORDER(^PXRMXT(810.3,"D",IEN,YEAR,PERIOD,IND))
if 'IND
QUIT
Begin DoDot:3
+9 SET NAME=$PIECE($GET(^PXRMXT(810.3,IND,0)),U)
if NAME=""
QUIT
+10 SET CNT=CNT+1
SET ORY(CNT)=IND_U_NAME
End DoDot:3
End DoDot:2
End DoDot:1
+11 IF CNT=0
SET ORY(1)="-1^no entries found"
+12 QUIT
+13 ;
ETLIST(ORY,IEN) ;Build a list of extract summary totals.
+1 NEW APPL,CNT,DATA,DUE,IND,RIEN,RNAME,SNAME,STATION,TOT
+2 ;Build the list in alphabetical order.
+3 SET IND=0
SET CNT=0
+4 FOR
SET IND=$ORDER(^PXRMXT(810.3,IEN,3,IND))
if 'IND
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMXT(810.3,IEN,3,IND,0))
if DATA=""
QUIT
+6 SET RIEN=$PIECE(DATA,U,2)
if 'RIEN
QUIT
+7 SET RNAME=$PIECE($GET(^PXD(811.9,RIEN,0)),U)
+8 SET STATION=$PIECE(DATA,U,3)
SET SNAME=STATION
+9 SET TOT=+$PIECE(DATA,U,5)
SET APPL=+$PIECE(DATA,U,6)
SET DUE=$PIECE(DATA,U,8)
+10 SET CNT=CNT+1
SET ORY(CNT)=RNAME_U_SNAME_U_TOT_U_APPL_U_DUE
End DoDot:1
+11 IF CNT=0
SET ORY(1)="-1^no entries found"
+12 QUIT
