PXRMOBJX ;SLC/AGP,JVS - CLINICAL REMINDERS ;5/15/03 14:15
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
Q
;
STATUS(DFN,ARRAY,MISSING) ;Evaluate The status of the Referral
;
N STOP,ZTSK,CNT,GEC1,GEC2,GEC3,GECF,SOURCE
S STOP=0,CNT=0,ARRAY=""
;
;Returned
;ARRAY as an array of information
;
N HFDA,STOP
D ACOPYDEL^PXRMGECK
;
;GET IEN FOR DATA SOURCES FOR GEC
I $D(^PX(839.7,"B","GEC1")) S GEC1=$O(^PX(839.7,"B","GEC1",""))
I $D(^PX(839.7,"B","GEC2")) S GEC2=$O(^PX(839.7,"B","GEC2",""))
I $D(^PX(839.7,"B","GEC3")) S GEC3=$O(^PX(839.7,"B","GEC3",""))
I $D(^PX(839.7,"B","GECF")) S GECF=$O(^PX(839.7,"B","GECF",""))
;
S STOP=0
S HFDA="" F S HFDA=$O(^AUPNVHF("C",DFN,HFDA)) Q:HFDA="" Q:STOP=1 D
.I $D(^AUPNVHF(HFDA,12)) D
..I $P($G(^AUPNVHF(HFDA,12)),"^",1)>0 D
...S SOURCE=$P($G(^AUPNVHF(HFDA,812)),"^",3)
...Q:SOURCE=""
...I (SOURCE=$G(GEC1))!(SOURCE=$G(GEC2))!(SOURCE=$G(GEC3))!(SOURCE=$G(GECF)) D
....S STOP=1
;
S (MISSING)=""
I '$D(^PXRMD(801.5,"B",DFN))&(STOP=0) D
.S ARRAY($$UP,1)="No GEC Referral on record."
I '$D(^PXRMD(801.5,"B",DFN))&(STOP=1) D
.S ARRAY($$UP,1)="No GEC Referral in progress."
Q:'$D(^PXRMD(801.5,"B",DFN))
;
;
; A. look for missing dialog
S:'$D(^PXRMD(801.5,"AD",DFN,"GEC1")) MISSING=MISSING_1_"^"
S:'$D(^PXRMD(801.5,"AD",DFN,"GEC2")) MISSING=MISSING_2_"^"
S:'$D(^PXRMD(801.5,"AD",DFN,"GEC3")) MISSING=MISSING_3_"^"
;S:'$D(^PXRMD(801.5,"AD",DFN,"GECF")) MISSING=MISSING_4
; a. if none missing then set message
; b. if missing then create message
I MISSING'=""!(MISSING="") D
.S ARRAY($$UP,1)="The following Dialog(s) are Complete:"
.S:MISSING'[1 ARRAY($$UP,1)=$P($T(T+7),";",3) D
..I +$$TIUSTAT^PXRMGECK(DFN,"GEC1") D
...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",4)
.S:MISSING'[2 ARRAY($$UP,1)=$P($T(T+8),";",3) D
..I +$$TIUSTAT^PXRMGECK(DFN,"GEC2") D
...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",4)
.S:MISSING'[3 ARRAY($$UP,1)=$P($T(T+9),";",3) D
..I +$$TIUSTAT^PXRMGECK(DFN,"GEC3") D
...S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",4)
.;S:MISSING'[4 ARRAY($$UP,1)=$P($T(T+10),";",3) D
.;.I +$$TIUSTAT^PXRMGECK(DFN,"GECF") D
.;..S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",4)
.I MISSING'="" S ARRAY($$UP,2)=$P($T(T+11),";",3)
.S:MISSING[1 ARRAY($$UP,2)=$P($T(T+7),";",3)
.S:MISSING[2 ARRAY($$UP,2)=$P($T(T+8),";",3)
.S:MISSING[3 ARRAY($$UP,2)=$P($T(T+9),";",3)
.;S:MISSING[4 ARRAY($$UP,2)=$P($T(T+10),";",3)
;
I MISSING="" S ARRAY($$UP,2)=$P($T(T+5),";",3)
;S MESSAGE=MESSAGE_$P($T(T+6),";",3)
;S MESSAGE=MESSAGE_"^Current GEC Referral Status"
;
Q
UP() ;
S CNT=CNT+1
Q CNT
;
T ;TEXT
;; Social Services,
;; Nursing Assessment,
;; Care Recommendations,
;; Care Coordination
;;
;;Is this Referral Complete?
;; Social Services
;; Nursing Assessment
;; Care Recommendations
;; Care Coordination
;;The Following Dialogs are Missing:
;; ~~(If you select Yes, the current REFERRAL ~will be completed and any missing ~information cannot be added.
;; ~~If you select No, the current REFERRAL ~will include the addition of missing information.)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMOBJX 3686 printed Dec 13, 2024@01:46:50 Page 2
PXRMOBJX ;SLC/AGP,JVS - CLINICAL REMINDERS ;5/15/03 14:15
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 QUIT
+3 ;
STATUS(DFN,ARRAY,MISSING) ;Evaluate The status of the Referral
+1 ;
+2 NEW STOP,ZTSK,CNT,GEC1,GEC2,GEC3,GECF,SOURCE
+3 SET STOP=0
SET CNT=0
SET ARRAY=""
+4 ;
+5 ;Returned
+6 ;ARRAY as an array of information
+7 ;
+8 NEW HFDA,STOP
+9 DO ACOPYDEL^PXRMGECK
+10 ;
+11 ;GET IEN FOR DATA SOURCES FOR GEC
+12 IF $DATA(^PX(839.7,"B","GEC1"))
SET GEC1=$ORDER(^PX(839.7,"B","GEC1",""))
+13 IF $DATA(^PX(839.7,"B","GEC2"))
SET GEC2=$ORDER(^PX(839.7,"B","GEC2",""))
+14 IF $DATA(^PX(839.7,"B","GEC3"))
SET GEC3=$ORDER(^PX(839.7,"B","GEC3",""))
+15 IF $DATA(^PX(839.7,"B","GECF"))
SET GECF=$ORDER(^PX(839.7,"B","GECF",""))
+16 ;
+17 SET STOP=0
+18 SET HFDA=""
FOR
SET HFDA=$ORDER(^AUPNVHF("C",DFN,HFDA))
if HFDA=""
QUIT
if STOP=1
QUIT
Begin DoDot:1
+19 IF $DATA(^AUPNVHF(HFDA,12))
Begin DoDot:2
+20 IF $PIECE($GET(^AUPNVHF(HFDA,12)),"^",1)>0
Begin DoDot:3
+21 SET SOURCE=$PIECE($GET(^AUPNVHF(HFDA,812)),"^",3)
+22 if SOURCE=""
QUIT
+23 IF (SOURCE=$GET(GEC1))!(SOURCE=$GET(GEC2))!(SOURCE=$GET(GEC3))!(SOURCE=$GET(GECF))
Begin DoDot:4
+24 SET STOP=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 SET (MISSING)=""
+27 IF '$DATA(^PXRMD(801.5,"B",DFN))&(STOP=0)
Begin DoDot:1
+28 SET ARRAY($$UP,1)="No GEC Referral on record."
End DoDot:1
+29 IF '$DATA(^PXRMD(801.5,"B",DFN))&(STOP=1)
Begin DoDot:1
+30 SET ARRAY($$UP,1)="No GEC Referral in progress."
End DoDot:1
+31 if '$DATA(^PXRMD(801.5,"B",DFN))
QUIT
+32 ;
+33 ;
+34 ; A. look for missing dialog
+35 if '$DATA(^PXRMD(801.5,"AD",DFN,"GEC1"))
SET MISSING=MISSING_1_"^"
+36 if '$DATA(^PXRMD(801.5,"AD",DFN,"GEC2"))
SET MISSING=MISSING_2_"^"
+37 if '$DATA(^PXRMD(801.5,"AD",DFN,"GEC3"))
SET MISSING=MISSING_3_"^"
+38 ;S:'$D(^PXRMD(801.5,"AD",DFN,"GECF")) MISSING=MISSING_4
+39 ; a. if none missing then set message
+40 ; b. if missing then create message
+41 IF MISSING'=""!(MISSING="")
Begin DoDot:1
+42 SET ARRAY($$UP,1)="The following Dialog(s) are Complete:"
+43 if MISSING'[1
SET ARRAY($$UP,1)=$PIECE($TEXT(T+7),";",3)
Begin DoDot:2
+44 IF +$$TIUSTAT^PXRMGECK(DFN,"GEC1")
Begin DoDot:3
+45 SET ARRAY($$UP,1)=" Note Status: "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",2)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",3)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC1"),":",4)
End DoDot:3
End DoDot:2
+46 if MISSING'[2
SET ARRAY($$UP,1)=$PIECE($TEXT(T+8),";",3)
Begin DoDot:2
+47 IF +$$TIUSTAT^PXRMGECK(DFN,"GEC2")
Begin DoDot:3
+48 SET ARRAY($$UP,1)=" Note Status: "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",2)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",3)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC2"),":",4)
End DoDot:3
End DoDot:2
+49 if MISSING'[3
SET ARRAY($$UP,1)=$PIECE($TEXT(T+9),";",3)
Begin DoDot:2
+50 IF +$$TIUSTAT^PXRMGECK(DFN,"GEC3")
Begin DoDot:3
+51 SET ARRAY($$UP,1)=" Note Status: "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",2)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",3)_" "_$PIECE($$TIUSTAT^PXRMGECK(DFN,"GEC3"),":",4)
End DoDot:3
End DoDot:2
+52 ;S:MISSING'[4 ARRAY($$UP,1)=$P($T(T+10),";",3) D
+53 ;.I +$$TIUSTAT^PXRMGECK(DFN,"GECF") D
+54 ;..S ARRAY($$UP,1)=" Note Status: "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",2)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",3)_" "_$P($$TIUSTAT^PXRMGECK(DFN,"GECF"),":",4)
+55 IF MISSING'=""
SET ARRAY($$UP,2)=$PIECE($TEXT(T+11),";",3)
+56 if MISSING[1
SET ARRAY($$UP,2)=$PIECE($TEXT(T+7),";",3)
+57 if MISSING[2
SET ARRAY($$UP,2)=$PIECE($TEXT(T+8),";",3)
+58 if MISSING[3
SET ARRAY($$UP,2)=$PIECE($TEXT(T+9),";",3)
+59 ;S:MISSING[4 ARRAY($$UP,2)=$P($T(T+10),";",3)
End DoDot:1
+60 ;
+61 IF MISSING=""
SET ARRAY($$UP,2)=$PIECE($TEXT(T+5),";",3)
+62 ;S MESSAGE=MESSAGE_$P($T(T+6),";",3)
+63 ;S MESSAGE=MESSAGE_"^Current GEC Referral Status"
+64 ;
+65 QUIT
UP() ;
+1 SET CNT=CNT+1
+2 QUIT CNT
+3 ;
T ;TEXT
+1 ;; Social Services,
+2 ;; Nursing Assessment,
+3 ;; Care Recommendations,
+4 ;; Care Coordination
+5 ;;
+6 ;;Is this Referral Complete?
+7 ;; Social Services
+8 ;; Nursing Assessment
+9 ;; Care Recommendations
+10 ;; Care Coordination
+11 ;;The Following Dialogs are Missing:
+12 ;; ~~(If you select Yes, the current REFERRAL ~will be completed and any missing ~information cannot be added.
+13 ;; ~~If you select No, the current REFERRAL ~will include the addition of missing information.)
+14 QUIT
