Routine: PXRMOBJX

PXRMOBJX ;SLC/AGP,JVS - CLINICAL REMINDERS ;5/15/03  14:15

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

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"

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.)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMOBJX   3686     printed  Feb 18, 2025@23:13:12                                                                                                                                                                                                    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

PXRMOBJX.m