VPSPTCR ;BPIFO/KG - Patient DUE NOW Reminders RPC;07/03/14 15:30
;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Jul 3,2014;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External Reference DBIA#
; ------------------------
; #2051 - FIND1^DIC (Supported)
; #2056 - GET1^DIQ (Supported)
; #2263 - GETWP^XPAR (Supported)
; #2263 - GETLST^XPAR (Supported)
; #2182 - MAIN^PXRM (Controlled Subs)
; #3333 - CATREM^PXRMAPI0 (Controlled Subs)
; #3960 - READ ACCESS TO File #811.7, Items .01 (Controlled Subs)
; #6113 - READ ACCESS TO File #811.9, Items 1.2, 1.6, 1.91, 103 (Controlled Subs)
; #10060 - READ ACCESS TO File #200, Items 16,29 (Supported)
; #1518 - READ ACCESS TO File #8989.3, Items 217 (Controlled Subs)
Q
;
REMIND(RESULT,DFN,DIV,SRV,LOC,USRCL) ;RPC: VPS GET CLINICAL REMINDERS
;Returns a list of patient's currently due PCE clinical reminders
;Input Parameter(s):
; DFN - Patient Identifier (File #2)
; DIV - Division Identifier (File #4)
; SRV - Service Identifier (File #49)
; LOC - Location Identifier (File #44)
; USRCL - List of User Classes separated by "^" (File #8930)
;Output Parameter(s):
; RESULT - Passed by reference, list of due now reminders
; Success : RESULT(0)=0, RESULT(1..n)= file 811.9 ien^reminder print name^date due^last occur.
; Error : RESULT(0)=-1^Error Message
;
N VPSLST,VPSI,VPSJ,VPSIEN,VPSTXT,VPSX,VPSLSTDT,VPSDUEDT,VPSPRI,VPSDUE,VPSSTA
;
; -- validate patient ID
I $G(DFN)="" S RESULT(0)="-1^PATIENT ID NOT SENT" Q
I '$D(^DPT(DFN)) S RESULT(0)="-1^PATIENT "_DFN_" NOT FOUND" Q
;
; -- get all cover sheer reminder list
D REMLIST(.VPSLST,$G(DIV),$G(SRV),$G(LOC),$G(USRCL))
;
; -- get clinical reminder for patient
S VPSI=0,VPSJ=0
F S VPSI=$O(VPSLST(VPSI)) Q:'VPSI D
. S VPSIEN=$P(VPSLST(VPSI),U,2)
. K ^TMP("PXRHM",$J)
. D MAIN^PXRM(DFN,VPSIEN,0)
. S VPSTXT="",VPSTXT=$O(^TMP("PXRHM",$J,VPSIEN,VPSTXT)) Q:VPSTXT="" D
. . S VPSX=^TMP("PXRHM",$J,VPSIEN,VPSTXT)
. . S VPSSTA=$P(VPSX,U,1),VPSDUEDT=$P(VPSX,U,2),VPSLSTDT=$P(VPSX,U,3)
. . S VPSLSTDT=$S(+$G(VPSLSTDT)>0:VPSLSTDT,1:"") ;null if not a date
. . S VPSJ=VPSJ+1
. . S VPSDUE=$S(VPSSTA["DUE":1,VPSSTA["ERROR":3,VPSSTA["CNBD":4,1:2)
. . I VPSDUE'=2 D I 1
. . . S VPSPRI=$$GET1^DIQ(811.9,VPSIEN_",",1.91,"I") ;Priority
. . . I VPSPRI="" S VPSPRI=2
. . E S VPSDUEDT="",VPSLSTDT="",VPSPRI=""
. . S RESULT(VPSJ)=VPSIEN_U_VPSTXT_U_VPSDUEDT_U_VPSLSTDT_U_VPSPRI_U_VPSDUE ;_U_$$DLG^PXRMRPCA(VPSIEN)_U_U_U_U_$$DLGWIPE^PXRMRPCA(VPSIEN)
. K ^TMP("PXRHM",$J)
;
I '$D(RESULT) S RESULT(0)="-1^NO CLINICAL REMINDERS FOUND FOR PATIENT "_DFN Q
S RESULT(0)=1
Q
;
REMACCUM(RESULT,LVL,TYP,SORT,CLASS) ;Gets Reminder data for each Parameter Entity
;Input Parameter(s):
; LVL - Parameter Entity
; TYP - Format of returned data
; SORT - Sort order for Reminders
; CLASS - User classes
;Output Parameter(s):
; RESULT - Sorted list of Reminders
;
; Format of entries in ORQQPX COVER SHEET REMINDERS:
; L:Lock;R:Remove;N:Normal / C:Category;R:Reminder / Cat or Rem IEN
N IDX,I,J,K,M,FOUND,VPSERR,VPSTMP,FLAG,IEN
N FFLAG,FIEN,OUT,P2,ADD,DOADD,CODE
I LVL="CLASS" D I 1
. N VPSLST,VPSCLS,VPSCLSPM,VPSWP
. S VPSCLSPM="ORQQPX COVER SHEET REM CLASSES"
. D GETLST^XPAR(.VPSLST,"SYS",VPSCLSPM,"Q",.VPSERR)
. S I=0,M=0,CLASS=$G(CLASS)
. F S I=$O(VPSLST(I)) Q:'I D
. . S VPSCLS=$P(VPSLST(I),U,1)
. . S ADD=0
. . I CLASS]"" S ADD=(U_CLASS_U)[(U_VPSCLS_U)
. . I +ADD D
. . . D GETWP^XPAR(.VPSWP,"SYS",VPSCLSPM,VPSCLS,.VPSERR)
. . . S K=0
. . . F S K=$O(VPSWP(K)) Q:'K D
. . . . S M=M+1
. . . . S J=$P(VPSWP(K,0),";",1)
. . . . S VPSTMP(M)=J_U_$P(VPSWP(K,0),";",2)
E D GETLST^XPAR(.VPSTMP,LVL,"ORQQPX COVER SHEET REMINDERS",TYP,.VPSERR)
S I=0,IDX=$O(RESULT(999999),-1)+1,ADD=(SORT="")
F S I=$O(VPSTMP(I)) Q:'I D
. S (FOUND,J)=0,P2=$P(VPSTMP(I),U,2)
. S FLAG=$E(P2),IEN=$E(P2,2,999)
. I ADD S DOADD=1
. E D
. . S DOADD=0
. . F S J=$O(RESULT(J)) Q:'J D Q:FOUND
. . . S P2=$P(RESULT(J),U,2)
. . . S FIEN=$E(P2,2,999)
. . . I FIEN=IEN S FOUND=J,FFLAG=$E(P2)
. . I FOUND D I 1
. . . I FLAG="R",FFLAG'="L" K RESULT(FOUND)
. . . I FLAG'=FFLAG,(FLAG_FFLAG)["L" S $E(P2)="L",$P(RESULT(FOUND),U,2)=P2
. . E I (FLAG'="R") S DOADD=1
. I DOADD D
. . S OUT(IDX)=VPSTMP(I)
. . S $P(OUT(IDX),U)=$P(OUT(IDX),U)_SORT
. . I SORT="" S OUT(IDX)=$$ADDNAME(OUT(IDX))
. . S IDX=IDX+1
M RESULT=OUT
Q
;
REMLIST(RESULT,DIV,SRV,LOC,UCL) ;Returns a list of all cover sheet reminders
;Input Parameter(s):
; DIV - Division Identifier
; SRV - Service Identifier
; LOC - Location Identifier
; UCL - List of User Classes separated by "^"
;Output Parameter(s):
; RESULT - Passed by reference, list of cover sheet reminders
;
N I,J,VPSLST,CODE,IDX,IEN,NEWP,VPSERR
;
D NEWCVOK(.NEWP,DIV,SRV)
I 'NEWP D GETLST^XPAR(.RESULT,"LOC.`"_+LOC_"^SRV.`"_+SRV_"^DIV.`"_+DIV_"^SYS^PKG","ORQQPX SEARCH ITEMS","Q",.VPSERR) Q
D REMACCUM(.VPSLST,"PKG","Q",1000)
D REMACCUM(.VPSLST,"SYS","Q",2000)
I +DIV D REMACCUM(.VPSLST,"DIV.`"_+DIV,"Q",3000)
I +SRV D REMACCUM(.VPSLST,"SRV.`"_+SRV,"Q",4000)
I +LOC D REMACCUM(.VPSLST,"LOC.`"_+LOC,"Q",5000)
I (UCL]"") D REMACCUM(.VPSLST,"CLASS","Q",6000,UCL)
S I=0
F S I=$O(VPSLST(I)) Q:'I D
. S IDX=$P(VPSLST(I),U,1)
. F Q:'$D(RESULT(IDX)) S IDX=IDX+1
. S CODE=$E($P(VPSLST(I),U,2),2)
. S IEN=$E($P(VPSLST(I),U,2),3,999)
. I CODE="R" D ADDREM(.RESULT,IDX,IEN)
. I CODE="C" D ADDCAT(.RESULT,IDX,IEN)
K RESULT("B")
Q
;
ADDNAME(VPSX) ;Add Reminder or Category Name
;Input Parameter(s):
; VPSX - Reminder Info
;Output Parameter(s):
; VPSX - Add name as 3rd piece
;
N CAT,IEN
S CAT=$E($P(VPSX,U,2),2)
S IEN=$E($P(VPSX,U,2),3,99)
I +IEN D
. I CAT="R" S $P(VPSX,U,3)=$$GET1^DIQ(811.9,IEN_",",1.2,"I") ;Print Name
. I CAT="C" S $P(VPSX,U,3)=$$GET1^DIQ(811.7,IEN_",",.01,"I") ;Name
Q VPSX
;
ADDREM(RESULT,IDX,IEN) ;Add Reminder to RESULT list, if applicable
;Input Parameter(s):
; IDX - External Reminder ID
; IEN - Internal Reminder ID
;Output Parameter(s):
; RESULT - Pass by reference, list of reminders
;
Q:$G(IDX)=""
Q:$G(IEN)=""
N USAGE
I $D(RESULT("B",IEN)) Q ; See if it's in the list
I '$$FIND1^DIC(811.9,,,"`"_IEN) Q ; Check if Exists
I $$GET1^DIQ(811.9,IEN_",",1.6,"I")'="" Q ; Check if Active
;check to see if the reminder is assigned to CPRS
S USAGE=$$GET1^DIQ(811.9,IEN_",",103,"I") ;Usage
I USAGE["L" Q
I USAGE'["C",USAGE'="*" Q
S RESULT(IDX)=IDX_U_IEN
S RESULT("B",IEN)=""
Q
;
ADDCAT(RESULT,IDX,IEN) ;Add Reminders in a Category Reminder to RESULT list individually
;Input Parameter(s):
; IDX - External Category Reminder ID
; IEN - Internal Category Reminder ID
;Output Parameter(s):
; RESULT - Pass by reference, list of reminders
;
Q:$G(IDX)=""
Q:$G(IEN)=""
N REM,I,IDX2,NREM
D CATREM^PXRMAPI0(IEN,.REM)
S I=0
F S I=$O(REM(I)) Q:'I D
. S IDX2="00000"_I
. S IDX2=$E(IDX2,$L(IDX2)-5,99)
. D ADDREM(.RESULT,+(IDX_"."_IDX2),$P(REM(I),U,1))
Q
;
NEWCVOK(RESULT,DIV,SRV) ; Checks if New or Old style Reminders are used
;Input Parameter(s):
; DIV - Division Identifier
; SRV - Service Identifier
;Output Parameter(s):
; RESULT - Passed by reference
; RESULT = 1 - if new style reminders
; RESULT = 0 - if old style reminders
;
N VPSERR,VPSTMP
S RESULT=0
D GETLST^XPAR(.VPSTMP,"SRV.`"_+$G(SRV)_"^DIV.`"_+$G(DIV)_"^SYS^PKG","ORQQPX NEW REMINDER PARAMS","Q",.VPSERR)
I +VPSTMP S RESULT=$P($G(VPSTMP(1)),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPSPTCR 7782 printed Dec 13, 2024@02:43:21 Page 2
VPSPTCR ;BPIFO/KG - Patient DUE NOW Reminders RPC;07/03/14 15:30
+1 ;;1.0;VA POINT OF SERVICE (KIOSKS);**4**;Jul 3,2014;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External Reference DBIA#
+5 ; ------------------------
+6 ; #2051 - FIND1^DIC (Supported)
+7 ; #2056 - GET1^DIQ (Supported)
+8 ; #2263 - GETWP^XPAR (Supported)
+9 ; #2263 - GETLST^XPAR (Supported)
+10 ; #2182 - MAIN^PXRM (Controlled Subs)
+11 ; #3333 - CATREM^PXRMAPI0 (Controlled Subs)
+12 ; #3960 - READ ACCESS TO File #811.7, Items .01 (Controlled Subs)
+13 ; #6113 - READ ACCESS TO File #811.9, Items 1.2, 1.6, 1.91, 103 (Controlled Subs)
+14 ; #10060 - READ ACCESS TO File #200, Items 16,29 (Supported)
+15 ; #1518 - READ ACCESS TO File #8989.3, Items 217 (Controlled Subs)
+16 QUIT
+17 ;
REMIND(RESULT,DFN,DIV,SRV,LOC,USRCL) ;RPC: VPS GET CLINICAL REMINDERS
+1 ;Returns a list of patient's currently due PCE clinical reminders
+2 ;Input Parameter(s):
+3 ; DFN - Patient Identifier (File #2)
+4 ; DIV - Division Identifier (File #4)
+5 ; SRV - Service Identifier (File #49)
+6 ; LOC - Location Identifier (File #44)
+7 ; USRCL - List of User Classes separated by "^" (File #8930)
+8 ;Output Parameter(s):
+9 ; RESULT - Passed by reference, list of due now reminders
+10 ; Success : RESULT(0)=0, RESULT(1..n)= file 811.9 ien^reminder print name^date due^last occur.
+11 ; Error : RESULT(0)=-1^Error Message
+12 ;
+13 NEW VPSLST,VPSI,VPSJ,VPSIEN,VPSTXT,VPSX,VPSLSTDT,VPSDUEDT,VPSPRI,VPSDUE,VPSSTA
+14 ;
+15 ; -- validate patient ID
+16 IF $GET(DFN)=""
SET RESULT(0)="-1^PATIENT ID NOT SENT"
QUIT
+17 IF '$DATA(^DPT(DFN))
SET RESULT(0)="-1^PATIENT "_DFN_" NOT FOUND"
QUIT
+18 ;
+19 ; -- get all cover sheer reminder list
+20 DO REMLIST(.VPSLST,$GET(DIV),$GET(SRV),$GET(LOC),$GET(USRCL))
+21 ;
+22 ; -- get clinical reminder for patient
+23 SET VPSI=0
SET VPSJ=0
+24 FOR
SET VPSI=$ORDER(VPSLST(VPSI))
if 'VPSI
QUIT
Begin DoDot:1
+25 SET VPSIEN=$PIECE(VPSLST(VPSI),U,2)
+26 KILL ^TMP("PXRHM",$JOB)
+27 DO MAIN^PXRM(DFN,VPSIEN,0)
+28 SET VPSTXT=""
SET VPSTXT=$ORDER(^TMP("PXRHM",$JOB,VPSIEN,VPSTXT))
if VPSTXT=""
QUIT
Begin DoDot:2
+29 SET VPSX=^TMP("PXRHM",$JOB,VPSIEN,VPSTXT)
+30 SET VPSSTA=$PIECE(VPSX,U,1)
SET VPSDUEDT=$PIECE(VPSX,U,2)
SET VPSLSTDT=$PIECE(VPSX,U,3)
+31 ;null if not a date
SET VPSLSTDT=$SELECT(+$GET(VPSLSTDT)>0:VPSLSTDT,1:"")
+32 SET VPSJ=VPSJ+1
+33 SET VPSDUE=$SELECT(VPSSTA["DUE":1,VPSSTA["ERROR":3,VPSSTA["CNBD":4,1:2)
+34 IF VPSDUE'=2
Begin DoDot:3
+35 ;Priority
SET VPSPRI=$$GET1^DIQ(811.9,VPSIEN_",",1.91,"I")
+36 IF VPSPRI=""
SET VPSPRI=2
End DoDot:3
IF 1
+37 IF '$TEST
SET VPSDUEDT=""
SET VPSLSTDT=""
SET VPSPRI=""
+38 ;_U_$$DLG^PXRMRPCA(VPSIEN)_U_U_U_U_$$DLGWIPE^PXRMRPCA(VPSIEN)
SET RESULT(VPSJ)=VPSIEN_U_VPSTXT_U_VPSDUEDT_U_VPSLSTDT_U_VPSPRI_U_VPSDUE
End DoDot:2
+39 KILL ^TMP("PXRHM",$JOB)
End DoDot:1
+40 ;
+41 IF '$DATA(RESULT)
SET RESULT(0)="-1^NO CLINICAL REMINDERS FOUND FOR PATIENT "_DFN
QUIT
+42 SET RESULT(0)=1
+43 QUIT
+44 ;
REMACCUM(RESULT,LVL,TYP,SORT,CLASS) ;Gets Reminder data for each Parameter Entity
+1 ;Input Parameter(s):
+2 ; LVL - Parameter Entity
+3 ; TYP - Format of returned data
+4 ; SORT - Sort order for Reminders
+5 ; CLASS - User classes
+6 ;Output Parameter(s):
+7 ; RESULT - Sorted list of Reminders
+8 ;
+9 ; Format of entries in ORQQPX COVER SHEET REMINDERS:
+10 ; L:Lock;R:Remove;N:Normal / C:Category;R:Reminder / Cat or Rem IEN
+11 NEW IDX,I,J,K,M,FOUND,VPSERR,VPSTMP,FLAG,IEN
+12 NEW FFLAG,FIEN,OUT,P2,ADD,DOADD,CODE
+13 IF LVL="CLASS"
Begin DoDot:1
+14 NEW VPSLST,VPSCLS,VPSCLSPM,VPSWP
+15 SET VPSCLSPM="ORQQPX COVER SHEET REM CLASSES"
+16 DO GETLST^XPAR(.VPSLST,"SYS",VPSCLSPM,"Q",.VPSERR)
+17 SET I=0
SET M=0
SET CLASS=$GET(CLASS)
+18 FOR
SET I=$ORDER(VPSLST(I))
if 'I
QUIT
Begin DoDot:2
+19 SET VPSCLS=$PIECE(VPSLST(I),U,1)
+20 SET ADD=0
+21 IF CLASS]""
SET ADD=(U_CLASS_U)[(U_VPSCLS_U)
+22 IF +ADD
Begin DoDot:3
+23 DO GETWP^XPAR(.VPSWP,"SYS",VPSCLSPM,VPSCLS,.VPSERR)
+24 SET K=0
+25 FOR
SET K=$ORDER(VPSWP(K))
if 'K
QUIT
Begin DoDot:4
+26 SET M=M+1
+27 SET J=$PIECE(VPSWP(K,0),";",1)
+28 SET VPSTMP(M)=J_U_$PIECE(VPSWP(K,0),";",2)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
IF 1
+29 IF '$TEST
DO GETLST^XPAR(.VPSTMP,LVL,"ORQQPX COVER SHEET REMINDERS",TYP,.VPSERR)
+30 SET I=0
SET IDX=$ORDER(RESULT(999999),-1)+1
SET ADD=(SORT="")
+31 FOR
SET I=$ORDER(VPSTMP(I))
if 'I
QUIT
Begin DoDot:1
+32 SET (FOUND,J)=0
SET P2=$PIECE(VPSTMP(I),U,2)
+33 SET FLAG=$EXTRACT(P2)
SET IEN=$EXTRACT(P2,2,999)
+34 IF ADD
SET DOADD=1
+35 IF '$TEST
Begin DoDot:2
+36 SET DOADD=0
+37 FOR
SET J=$ORDER(RESULT(J))
if 'J
QUIT
Begin DoDot:3
+38 SET P2=$PIECE(RESULT(J),U,2)
+39 SET FIEN=$EXTRACT(P2,2,999)
+40 IF FIEN=IEN
SET FOUND=J
SET FFLAG=$EXTRACT(P2)
End DoDot:3
if FOUND
QUIT
+41 IF FOUND
Begin DoDot:3
+42 IF FLAG="R"
IF FFLAG'="L"
KILL RESULT(FOUND)
+43 IF FLAG'=FFLAG
IF (FLAG_FFLAG)["L"
SET $EXTRACT(P2)="L"
SET $PIECE(RESULT(FOUND),U,2)=P2
End DoDot:3
IF 1
+44 IF '$TEST
IF (FLAG'="R")
SET DOADD=1
End DoDot:2
+45 IF DOADD
Begin DoDot:2
+46 SET OUT(IDX)=VPSTMP(I)
+47 SET $PIECE(OUT(IDX),U)=$PIECE(OUT(IDX),U)_SORT
+48 IF SORT=""
SET OUT(IDX)=$$ADDNAME(OUT(IDX))
+49 SET IDX=IDX+1
End DoDot:2
End DoDot:1
+50 MERGE RESULT=OUT
+51 QUIT
+52 ;
REMLIST(RESULT,DIV,SRV,LOC,UCL) ;Returns a list of all cover sheet reminders
+1 ;Input Parameter(s):
+2 ; DIV - Division Identifier
+3 ; SRV - Service Identifier
+4 ; LOC - Location Identifier
+5 ; UCL - List of User Classes separated by "^"
+6 ;Output Parameter(s):
+7 ; RESULT - Passed by reference, list of cover sheet reminders
+8 ;
+9 NEW I,J,VPSLST,CODE,IDX,IEN,NEWP,VPSERR
+10 ;
+11 DO NEWCVOK(.NEWP,DIV,SRV)
+12 IF 'NEWP
DO GETLST^XPAR(.RESULT,"LOC.`"_+LOC_"^SRV.`"_+SRV_"^DIV.`"_+DIV_"^SYS^PKG","ORQQPX SEARCH ITEMS","Q",.VPSERR)
QUIT
+13 DO REMACCUM(.VPSLST,"PKG","Q",1000)
+14 DO REMACCUM(.VPSLST,"SYS","Q",2000)
+15 IF +DIV
DO REMACCUM(.VPSLST,"DIV.`"_+DIV,"Q",3000)
+16 IF +SRV
DO REMACCUM(.VPSLST,"SRV.`"_+SRV,"Q",4000)
+17 IF +LOC
DO REMACCUM(.VPSLST,"LOC.`"_+LOC,"Q",5000)
+18 IF (UCL]"")
DO REMACCUM(.VPSLST,"CLASS","Q",6000,UCL)
+19 SET I=0
+20 FOR
SET I=$ORDER(VPSLST(I))
if 'I
QUIT
Begin DoDot:1
+21 SET IDX=$PIECE(VPSLST(I),U,1)
+22 FOR
if '$DATA(RESULT(IDX))
QUIT
SET IDX=IDX+1
+23 SET CODE=$EXTRACT($PIECE(VPSLST(I),U,2),2)
+24 SET IEN=$EXTRACT($PIECE(VPSLST(I),U,2),3,999)
+25 IF CODE="R"
DO ADDREM(.RESULT,IDX,IEN)
+26 IF CODE="C"
DO ADDCAT(.RESULT,IDX,IEN)
End DoDot:1
+27 KILL RESULT("B")
+28 QUIT
+29 ;
ADDNAME(VPSX) ;Add Reminder or Category Name
+1 ;Input Parameter(s):
+2 ; VPSX - Reminder Info
+3 ;Output Parameter(s):
+4 ; VPSX - Add name as 3rd piece
+5 ;
+6 NEW CAT,IEN
+7 SET CAT=$EXTRACT($PIECE(VPSX,U,2),2)
+8 SET IEN=$EXTRACT($PIECE(VPSX,U,2),3,99)
+9 IF +IEN
Begin DoDot:1
+10 ;Print Name
IF CAT="R"
SET $PIECE(VPSX,U,3)=$$GET1^DIQ(811.9,IEN_",",1.2,"I")
+11 ;Name
IF CAT="C"
SET $PIECE(VPSX,U,3)=$$GET1^DIQ(811.7,IEN_",",.01,"I")
End DoDot:1
+12 QUIT VPSX
+13 ;
ADDREM(RESULT,IDX,IEN) ;Add Reminder to RESULT list, if applicable
+1 ;Input Parameter(s):
+2 ; IDX - External Reminder ID
+3 ; IEN - Internal Reminder ID
+4 ;Output Parameter(s):
+5 ; RESULT - Pass by reference, list of reminders
+6 ;
+7 if $GET(IDX)=""
QUIT
+8 if $GET(IEN)=""
QUIT
+9 NEW USAGE
+10 ; See if it's in the list
IF $DATA(RESULT("B",IEN))
QUIT
+11 ; Check if Exists
IF '$$FIND1^DIC(811.9,,,"`"_IEN)
QUIT
+12 ; Check if Active
IF $$GET1^DIQ(811.9,IEN_",",1.6,"I")'=""
QUIT
+13 ;check to see if the reminder is assigned to CPRS
+14 ;Usage
SET USAGE=$$GET1^DIQ(811.9,IEN_",",103,"I")
+15 IF USAGE["L"
QUIT
+16 IF USAGE'["C"
IF USAGE'="*"
QUIT
+17 SET RESULT(IDX)=IDX_U_IEN
+18 SET RESULT("B",IEN)=""
+19 QUIT
+20 ;
ADDCAT(RESULT,IDX,IEN) ;Add Reminders in a Category Reminder to RESULT list individually
+1 ;Input Parameter(s):
+2 ; IDX - External Category Reminder ID
+3 ; IEN - Internal Category Reminder ID
+4 ;Output Parameter(s):
+5 ; RESULT - Pass by reference, list of reminders
+6 ;
+7 if $GET(IDX)=""
QUIT
+8 if $GET(IEN)=""
QUIT
+9 NEW REM,I,IDX2,NREM
+10 DO CATREM^PXRMAPI0(IEN,.REM)
+11 SET I=0
+12 FOR
SET I=$ORDER(REM(I))
if 'I
QUIT
Begin DoDot:1
+13 SET IDX2="00000"_I
+14 SET IDX2=$EXTRACT(IDX2,$LENGTH(IDX2)-5,99)
+15 DO ADDREM(.RESULT,+(IDX_"."_IDX2),$PIECE(REM(I),U,1))
End DoDot:1
+16 QUIT
+17 ;
NEWCVOK(RESULT,DIV,SRV) ; Checks if New or Old style Reminders are used
+1 ;Input Parameter(s):
+2 ; DIV - Division Identifier
+3 ; SRV - Service Identifier
+4 ;Output Parameter(s):
+5 ; RESULT - Passed by reference
+6 ; RESULT = 1 - if new style reminders
+7 ; RESULT = 0 - if old style reminders
+8 ;
+9 NEW VPSERR,VPSTMP
+10 SET RESULT=0
+11 DO GETLST^XPAR(.VPSTMP,"SRV.`"_+$GET(SRV)_"^DIV.`"_+$GET(DIV)_"^SYS^PKG","ORQQPX NEW REMINDER PARAMS","Q",.VPSERR)
+12 IF +VPSTMP
SET RESULT=$PIECE($GET(VPSTMP(1)),U,2)
+13 QUIT
