PXRMEOC ;SLC/AGP - Reminder Episode of Care;08/12/2017
;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
Q
;
KILL(VALUE) ;
I $G(VALUE(2))'="O",+$G(VALUE(1))>0,VALUE(3)'="" Q 1
Q 0
;
SET(VALUE) ;
I $G(VALUE(2))="O",+$G(VALUE(1))>0,VALUE(3)'="" Q 1
Q 0
;
ADD(PAT,DATE,ITEM,START,CLOSE,NAME,ERROR) ;
N FDA,IEN,OPEN
S OPEN=0
S IEN=$$ISOPEN(PAT,NAME)
I IEN>0,CLOSE=1 S FDA(809,IEN_",",3)="CLOSED"
I IEN'>0,START=1 D
.S FDA(809,"+1,",.01)=DATE
.S FDA(809,"+1,",1)=NAME
.S FDA(809,"+1,",2)="`"_PAT
.S FDA(809,"+1,",3)="OPEN"
.S IEN=1,OPEN=1
I IEN'>0 Q
D ADDITEM(.FDA,IEN,DATE,ITEM,OPEN)
D UPDATE(.FDA,.ERROR)
Q
;
ADDITEM(FDA,IEN,DATE,ITEM,OPEN) ;
N EXIST,IENS,ID
;S IENS="+"_(IEN+1)_","_$S(OPEN=1:"+",1:"")_IEN_","
S ID=$$INTITEM(ITEM) I ID="" Q
S EXIST=$$EXIST(IEN,ITEM,OPEN)
I EXIST>0 S IENS=EXIST_","_IEN_","
I EXIST=0 S IENS="+"_(IEN+1)_","_$S(OPEN=1:"+",1:"")_IEN_","
S FDA(809.04,IENS,.01)=ID
I EXIST=0 S FDA(809.04,IENS,1)=DATE
S FDA(809.04,IENS,4)=DATE
;I +$G(VISIT)>0 S FDA(809.04,IENS,2)="`"_VISIT
Q
;
CLOSE(RESULT,INPUT) ;
N DATE,IEN,MSG,NAME,PAT,STATUS
S NAME=$G(INPUT("NAME")) I NAME="" S RESULT(1)="-1^Cascade name not found" Q
S STATUS="CLOSED"
;S STATUS=$G(INPUT("STATUS")) I STATUS="" S RESULT(1)="-1^Cascade status not found" Q
S PAT=INPUT("DFN")
;I STATUS="CLOSED" S IEN=$O(^PXRM(809,"OPEN",PAT,NAME,"")) I IEN'>0 S RESULT(1)="-1^No open cascade found" Q
S IEN=$O(^PXRM(809,"OPEN",PAT,NAME,"")) I IEN'>0 S RESULT(1)="-1^No open cascade found" Q
S DATE=$P($G(^PXRM(809,IEN,0)),U)
S FDA(809,IEN_",",.01)=DATE
S FDA(809,IEN_",",3)=STATUS
D UPDATE^DIE("E","FDA","","MSG")
I $D(MSG) S RESULT(0)="-1^Could not update exisiting cascade entry" Q
S RESULT(1)=1
Q
;
EXIST(IEN,ITEM,OPEN) ;
N RESULT
S RESULT=0
I OPEN=1 Q RESULT
I '$D(^PXRM(809,IEN,1,"B",ITEM)) Q RESULT
S RESULT=+$O(^PXRM(809,IEN,1,"B",ITEM,""))
Q RESULT
;
GETOLIST(RESULT,PAT,NAME) ;
N INC,IEN,NODE
S IEN=$$ISOPEN(PAT,NAME) I IEN'>0 Q
S INC=0 F S INC=$O(^PXRM(809,IEN,1,INC)) Q:INC'>0 D
.S NODE=$G(^PXRM(809,IEN,1,INC,0)) Q:$P(NODE,U)=""
.S RESULT($P(NODE,U))=NODE
Q
;
INTITEM(ITEM) ;
N ARRAY,ID,GBL,RESULT,SYN
S RESULT=""
S ID=$P(ITEM,";"),GBL=$P(ITEM,";",2)
I ID=""!(GBL="") Q ""
D SETARRAY(.ARRAY)
S SYN=$G(ARRAY(GBL)) I SYN="" Q ""
S RESULT=SYN_".`"_ID
Q RESULT
;
ISOPEN(DFN,NAME) ;
N IEN
S IEN=+$O(^PXRM(809,"OPEN",DFN,NAME,""))
Q IEN
;
SETARRAY(ARRAY) ;
S ARRAY("OR(100,")="ORD"
S ARRAY("WV(790.1,")="WVP"
S ARRAY("WV(790.4,")="WVN"
Q
;
UPDATE(FDA,ERROR) ;
N MSG
D UPDATE^DIE("E","FDA","","MSG")
I $D(MSG) D ACOPY^PXRMUTIL("MSG","ERROR()")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEOC 2711 printed Dec 13, 2024@01:44:33 Page 2
PXRMEOC ;SLC/AGP - Reminder Episode of Care;08/12/2017
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
+2 QUIT
+3 ;
KILL(VALUE) ;
+1 IF $GET(VALUE(2))'="O"
IF +$GET(VALUE(1))>0
IF VALUE(3)'=""
QUIT 1
+2 QUIT 0
+3 ;
SET(VALUE) ;
+1 IF $GET(VALUE(2))="O"
IF +$GET(VALUE(1))>0
IF VALUE(3)'=""
QUIT 1
+2 QUIT 0
+3 ;
ADD(PAT,DATE,ITEM,START,CLOSE,NAME,ERROR) ;
+1 NEW FDA,IEN,OPEN
+2 SET OPEN=0
+3 SET IEN=$$ISOPEN(PAT,NAME)
+4 IF IEN>0
IF CLOSE=1
SET FDA(809,IEN_",",3)="CLOSED"
+5 IF IEN'>0
IF START=1
Begin DoDot:1
+6 SET FDA(809,"+1,",.01)=DATE
+7 SET FDA(809,"+1,",1)=NAME
+8 SET FDA(809,"+1,",2)="`"_PAT
+9 SET FDA(809,"+1,",3)="OPEN"
+10 SET IEN=1
SET OPEN=1
End DoDot:1
+11 IF IEN'>0
QUIT
+12 DO ADDITEM(.FDA,IEN,DATE,ITEM,OPEN)
+13 DO UPDATE(.FDA,.ERROR)
+14 QUIT
+15 ;
ADDITEM(FDA,IEN,DATE,ITEM,OPEN) ;
+1 NEW EXIST,IENS,ID
+2 ;S IENS="+"_(IEN+1)_","_$S(OPEN=1:"+",1:"")_IEN_","
+3 SET ID=$$INTITEM(ITEM)
IF ID=""
QUIT
+4 SET EXIST=$$EXIST(IEN,ITEM,OPEN)
+5 IF EXIST>0
SET IENS=EXIST_","_IEN_","
+6 IF EXIST=0
SET IENS="+"_(IEN+1)_","_$SELECT(OPEN=1:"+",1:"")_IEN_","
+7 SET FDA(809.04,IENS,.01)=ID
+8 IF EXIST=0
SET FDA(809.04,IENS,1)=DATE
+9 SET FDA(809.04,IENS,4)=DATE
+10 ;I +$G(VISIT)>0 S FDA(809.04,IENS,2)="`"_VISIT
+11 QUIT
+12 ;
CLOSE(RESULT,INPUT) ;
+1 NEW DATE,IEN,MSG,NAME,PAT,STATUS
+2 SET NAME=$GET(INPUT("NAME"))
IF NAME=""
SET RESULT(1)="-1^Cascade name not found"
QUIT
+3 SET STATUS="CLOSED"
+4 ;S STATUS=$G(INPUT("STATUS")) I STATUS="" S RESULT(1)="-1^Cascade status not found" Q
+5 SET PAT=INPUT("DFN")
+6 ;I STATUS="CLOSED" S IEN=$O(^PXRM(809,"OPEN",PAT,NAME,"")) I IEN'>0 S RESULT(1)="-1^No open cascade found" Q
+7 SET IEN=$ORDER(^PXRM(809,"OPEN",PAT,NAME,""))
IF IEN'>0
SET RESULT(1)="-1^No open cascade found"
QUIT
+8 SET DATE=$PIECE($GET(^PXRM(809,IEN,0)),U)
+9 SET FDA(809,IEN_",",.01)=DATE
+10 SET FDA(809,IEN_",",3)=STATUS
+11 DO UPDATE^DIE("E","FDA","","MSG")
+12 IF $DATA(MSG)
SET RESULT(0)="-1^Could not update exisiting cascade entry"
QUIT
+13 SET RESULT(1)=1
+14 QUIT
+15 ;
EXIST(IEN,ITEM,OPEN) ;
+1 NEW RESULT
+2 SET RESULT=0
+3 IF OPEN=1
QUIT RESULT
+4 IF '$DATA(^PXRM(809,IEN,1,"B",ITEM))
QUIT RESULT
+5 SET RESULT=+$ORDER(^PXRM(809,IEN,1,"B",ITEM,""))
+6 QUIT RESULT
+7 ;
GETOLIST(RESULT,PAT,NAME) ;
+1 NEW INC,IEN,NODE
+2 SET IEN=$$ISOPEN(PAT,NAME)
IF IEN'>0
QUIT
+3 SET INC=0
FOR
SET INC=$ORDER(^PXRM(809,IEN,1,INC))
if INC'>0
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^PXRM(809,IEN,1,INC,0))
if $PIECE(NODE,U)=""
QUIT
+5 SET RESULT($PIECE(NODE,U))=NODE
End DoDot:1
+6 QUIT
+7 ;
INTITEM(ITEM) ;
+1 NEW ARRAY,ID,GBL,RESULT,SYN
+2 SET RESULT=""
+3 SET ID=$PIECE(ITEM,";")
SET GBL=$PIECE(ITEM,";",2)
+4 IF ID=""!(GBL="")
QUIT ""
+5 DO SETARRAY(.ARRAY)
+6 SET SYN=$GET(ARRAY(GBL))
IF SYN=""
QUIT ""
+7 SET RESULT=SYN_".`"_ID
+8 QUIT RESULT
+9 ;
ISOPEN(DFN,NAME) ;
+1 NEW IEN
+2 SET IEN=+$ORDER(^PXRM(809,"OPEN",DFN,NAME,""))
+3 QUIT IEN
+4 ;
SETARRAY(ARRAY) ;
+1 SET ARRAY("OR(100,")="ORD"
+2 SET ARRAY("WV(790.1,")="WVP"
+3 SET ARRAY("WV(790.4,")="WVN"
+4 QUIT
+5 ;
UPDATE(FDA,ERROR) ;
+1 NEW MSG
+2 DO UPDATE^DIE("E","FDA","","MSG")
+3 IF $DATA(MSG)
DO ACOPY^PXRMUTIL("MSG","ERROR()")
+4 QUIT
