Routine: RAIPS196

RAIPS196 ;WOIFO/KLM - PostInit 196 ; Dec 08, 2022@11:47:48

 ;;5.0;Radiology/Nuclear Medicine;**196**;Mar 16, 1998;Build 1

 ; This post-install routine will loop through all HELD,

 ; COMPLETED, and DISCONTINUED Radiology orders and determine

 ; if they've been referred to community care via the auto

 ; referral option. If so, the REFERRED TO COMMUNITY CARE?

 ; field (#201) will be set to YES.

 ; Field #201 in file #75.1 is new with patch RA*5*196

 ; File/API            IA          Type

 ; -------------------------------------

 ; ^OR(100,D0,8,D1    6475        (P)

 ; ^GMR(123           6116        (C)

 ; INSTALDT^XPDUTL    10141       (S)

 ; SENDMSG^XMXAPI     2729        (S)

EN1 ;entry point from KIDS

 N RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE S ZTIO=""

 S ZTRTN="TASK^RAIPS196",(ZTDESC,RATXT(1))="RA196: Identify auto referred orders to community care"

 S ZTDTH=$H D ^%ZTLOAD S RATXT(2)="Task: "_$S($G(ZTSK)>0:ZTSK,1:"in error")

 D BMES^XPDUTL(.RATXT)

TASK ;Task entry point

 N RATEXT

 D ORDERCHK ;Check referred order

 D MSG

ORDERCHK ;search for held, completed and discontinued referred orders

 N RA148DT,RAODD,RAR,RAOIEN,RAORDA,RAERR,RARC,RAEC,RATC,RAIENS,RAFDA,RAORACT

 N RASQ,RASPACE,RACODE,RAEIEN,RAERTX,RAL

 F RASQ=1:1:50 S RASPACE=$G(RASPACE)_" "

 S (RARC,RAEC,RATC)=0

 D INSTALDT^XPDUTL("RA*5.0*148",.RAR)

 Q:RAR<1  ;148 not installed

 S RA148DT=$P($O(RAR(0)),".") Q:RA148DT=""  ;no install date

 S RAODD=RA148DT F  S RAODD=$O(^RAO(75.1,"BDD",RAODD)) Q:RAODD=""  D

 .S RAOIEN="" F  S RAOIEN=$O(^RAO(75.1,"BDD",RAODD,RAOIEN)) Q:RAOIEN=""  D

 ..I "^1^2^3^"'[$P(^RAO(75.1,RAOIEN,0),U,5) Q

 ..S RAORDA=$P(^RAO(75.1,RAOIEN,0),U,7) Q:RAORDA=""

 ..S RAORDA=RAORDA_",",RATC=RATC+1 ;increment total counter

 ..K RAORACT D GETS^DIQ(100,RAORDA,".8*","N","RAORACT") ;order actions

 ..I '$D(RAORACT) Q

 ..I $$CHKORACT(.RAORACT) D

 ...K RAIENS,RAFDA

 ...S RAIENS=RAOIEN_"," S RAFDA(75.1,RAIENS,201)="YES"

 ...K RAERR D FILE^DIE("EK","RAFDA","RAERR")

 ...I $D(RAERR) S RATEXT(10)="There was a problem updating some orders:" D

 ....S RATEXT(12)="ORDER IEN         ERROR"

 ....S RATEXT(13)="----------------  ------------------------------------------"

 ....S RAEIEN=+$G(RAERR("DIERR",1,"PARAM","IENS")),RAL=$L(RAEIEN),RAEC=RAEC+1

 ....S RAERTX=$E($G(RAERR("DIERR",1,"TEXT",1)),1,42)

 ....S RACODE=$G(RAERR("DIERR",1))

 ....S RATEXT(13+RAEC)=RAEIEN_$E(RASPACE,1,18-RAL)_"("_RACODE_") "_RAERTX

 ....Q

 ...E  S RARC=RARC+1 ;increment referred counter

 ...Q

..Q

.Q

 S RATEXT(8)="Total orders checked: "_RATC

 I RARC>0 S RATEXT(9)="Total orders updated: "_RARC

 E  S RATEXT(9)="There were no auto referred orders found to update."

 ;ZW RATEXT

CHKORACT(RAORACT) ;Check if order was referred using our option

 N RACOM,RAIENS,RAQ,RA123 S RAQ=0

 S RAIENS="" F  S RAIENS=$O(RAORACT(100.008,RAIENS)) Q:RAIENS=""  D

 .S RACOM=$G(RAORACT(100.008,RAIENS,1))

 .I RACOM["Placed on hold due to transfer to Community Care with UCID" D

 ..S RA123=$P(RACOM,"UCID",2) Q:'$D(RA123)

 ..S RA123=$P(RA123,"_",2) I RA123?1.N,$D(^GMR(123,RA123)) S RAQ=1

..Q

.Q

 Q RAQ

MSG ;send results via Mailman

 N RAID,RASUB,RAREC,RAINSTR

 I '$D(RATEXT) S RATEXT(8)="*** No referred orders found! ***"

 ;Mail message introductory blurb...

 S RATEXT(1)="The Post-Init task for RA*5.0*196 searched for radiology"

 S RATEXT(2)="orders in a complete, discontinued or held status that"

 S RATEXT(3)="have previously been referred to community care using"

 S RATEXT(4)="the Refer Selected Requests to COMMUNITY CARE Provider"

 S RATEXT(5)="option. Orders previously referred using this option"

 S RATEXT(6)="had the new Referred to Community Care? field set to YES."

 S RATEXT(7)="",RATEXT(11)=""

 ;XMTEXT for message text

 ;S XMTEXT="RATEXT("

 S RASUB="RAD/NUC MED RA*5.0*196 Post-Install Information"

 S RAID=+$G(DUZ)

 S RAREC(RAID)="" ;send to installer

 S RAINSTR("FROM")="RA*5.0*196 Post-Install"

 D SENDMSG^XMXAPI(RAID,RASUB,"RATEXT",.RAREC,.RAINSTR,,)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS196   4044     printed  Mar 13, 2025@21:41:02                                                                                                                                                                                                    Page 2

RAIPS196  ;WOIFO/KLM - PostInit 196 ; Dec 08, 2022@11:47:48

 +1       ;;5.0;Radiology/Nuclear Medicine;**196**;Mar 16, 1998;Build 1

 +2       ;

 +3       ; This post-install routine will loop through all HELD,

 +4       ; COMPLETED, and DISCONTINUED Radiology orders and determine

 +5       ; if they've been referred to community care via the auto

 +6       ; referral option. If so, the REFERRED TO COMMUNITY CARE?

 +7       ; field (#201) will be set to YES.

 +8       ;

 +9       ;

 +10      ; Field #201 in file #75.1 is new with patch RA*5*196

 +11      ;

 +12      ; File/API            IA          Type

 +13      ; -------------------------------------

 +14      ; ^OR(100,D0,8,D1    6475        (P)

 +15      ; ^GMR(123           6116        (C)

 +16      ; INSTALDT^XPDUTL    10141       (S)

 +17      ; SENDMSG^XMXAPI     2729        (S)

 +18      ;

EN1       ;entry point from KIDS

 +1        NEW RATXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE

           SET ZTIO=""

 +2        SET ZTRTN="TASK^RAIPS196"

           SET (ZTDESC,RATXT(1))="RA196: Identify auto referred orders to community care"

 +3        SET ZTDTH=$HOROLOG

           DO ^%ZTLOAD

           SET RATXT(2)="Task: "_$SELECT($GET(ZTSK)>0:ZTSK,1:"in error")

 +4        DO BMES^XPDUTL(.RATXT)

 +5        QUIT

 +6       ;

TASK      ;Task entry point

 +1        NEW RATEXT

 +2       ;Check referred order

           DO ORDERCHK

 +3        DO MSG

 +4        QUIT

ORDERCHK  ;search for held, completed and discontinued referred orders

 +1        NEW RA148DT,RAODD,RAR,RAOIEN,RAORDA,RAERR,RARC,RAEC,RATC,RAIENS,RAFDA,RAORACT

 +2        NEW RASQ,RASPACE,RACODE,RAEIEN,RAERTX,RAL

 +3        FOR RASQ=1:1:50

               SET RASPACE=$GET(RASPACE)_" "

 +4        SET (RARC,RAEC,RATC)=0

 +5        DO INSTALDT^XPDUTL("RA*5.0*148",.RAR)

 +6       ;148 not installed

           if RAR<1

               QUIT

 +7       ;no install date

           SET RA148DT=$PIECE($ORDER(RAR(0)),".")

           if RA148DT=""

               QUIT

 +8        SET RAODD=RA148DT

FOR

               SET RAODD=$ORDER(^RAO(75.1,"BDD",RAODD))

               if RAODD=""

                   QUIT

               Begin DoDot:1

 +9                SET RAOIEN=""

FOR

                       SET RAOIEN=$ORDER(^RAO(75.1,"BDD",RAODD,RAOIEN))

                       if RAOIEN=""

                           QUIT

                       Begin DoDot:2

 +10                       IF "^1^2^3^"'[$PIECE(^RAO(75.1,RAOIEN,0),U,5)

                               QUIT

 +11                       SET RAORDA=$PIECE(^RAO(75.1,RAOIEN,0),U,7)

                           if RAORDA=""

                               QUIT

 +12      ;increment total counter

                           SET RAORDA=RAORDA_","

                           SET RATC=RATC+1

 +13      ;order actions

                           KILL RAORACT

                           DO GETS^DIQ(100,RAORDA,".8*","N","RAORACT")

 +14                       IF '$DATA(RAORACT)

                               QUIT

 +15                       IF $$CHKORACT(.RAORACT)

                               Begin DoDot:3

 +16                               KILL RAIENS,RAFDA

 +17                               SET RAIENS=RAOIEN_","

                                   SET RAFDA(75.1,RAIENS,201)="YES"

 +18                               KILL RAERR

                                   DO FILE^DIE("EK","RAFDA","RAERR")

 +19                               IF $DATA(RAERR)

                                       SET RATEXT(10)="There was a problem updating some orders:"

                                       Begin DoDot:4

 +20                                       SET RATEXT(12)="ORDER IEN         ERROR"

 +21                                       SET RATEXT(13)="----------------  ------------------------------------------"

 +22                                       SET RAEIEN=+$GET(RAERR("DIERR",1,"PARAM","IENS"))

                                           SET RAL=$LENGTH(RAEIEN)

                                           SET RAEC=RAEC+1

 +23                                       SET RAERTX=$EXTRACT($GET(RAERR("DIERR",1,"TEXT",1)),1,42)

 +24                                       SET RACODE=$GET(RAERR("DIERR",1))

 +25                                       SET RATEXT(13+RAEC)=RAEIEN_$EXTRACT(RASPACE,1,18-RAL)_"("_RACODE_") "_RAERTX

 +26                                       QUIT

                                       End DoDot:4

 +27      ;increment referred counter

                                  IF '$TEST

                                       SET RARC=RARC+1

 +28                               QUIT

                               End DoDot:3

 +29                       QUIT

                       End DoDot:2

 +30               QUIT

               End DoDot:1

 +31       SET RATEXT(8)="Total orders checked: "_RATC

 +32       IF RARC>0

               SET RATEXT(9)="Total orders updated: "_RARC

 +33      IF '$TEST

               SET RATEXT(9)="There were no auto referred orders found to update."

 +34      ;ZW RATEXT

 +35       QUIT

CHKORACT(RAORACT) ;Check if order was referred using our option

 +1        NEW RACOM,RAIENS,RAQ,RA123

           SET RAQ=0

 +2        SET RAIENS=""

FOR

               SET RAIENS=$ORDER(RAORACT(100.008,RAIENS))

               if RAIENS=""

                   QUIT

               Begin DoDot:1

 +3                SET RACOM=$GET(RAORACT(100.008,RAIENS,1))

 +4                IF RACOM["Placed on hold due to transfer to Community Care with UCID"

                       Begin DoDot:2

 +5                        SET RA123=$PIECE(RACOM,"UCID",2)

                           if '$DATA(RA123)

                               QUIT

 +6                        SET RA123=$PIECE(RA123,"_",2)

                           IF RA123?1.N

                               IF $DATA(^GMR(123,RA123))

                                   SET RAQ=1

 +7                        QUIT

                       End DoDot:2

 +8                QUIT

               End DoDot:1

 +9        QUIT RAQ

MSG       ;send results via Mailman

 +1        NEW RAID,RASUB,RAREC,RAINSTR

 +2        IF '$DATA(RATEXT)

               SET RATEXT(8)="*** No referred orders found! ***"

 +3       ;Mail message introductory blurb...

 +4        SET RATEXT(1)="The Post-Init task for RA*5.0*196 searched for radiology"

 +5        SET RATEXT(2)="orders in a complete, discontinued or held status that"

 +6        SET RATEXT(3)="have previously been referred to community care using"

 +7        SET RATEXT(4)="the Refer Selected Requests to COMMUNITY CARE Provider"

 +8        SET RATEXT(5)="option. Orders previously referred using this option"

 +9        SET RATEXT(6)="had the new Referred to Community Care? field set to YES."

 +10       SET RATEXT(7)=""

           SET RATEXT(11)=""

 +11      ;XMTEXT for message text

 +12      ;S XMTEXT="RATEXT("

 +13       SET RASUB="RAD/NUC MED RA*5.0*196 Post-Install Information"

 +14       SET RAID=+$GET(DUZ)

 +15      ;send to installer

           SET RAREC(RAID)=""

 +16       SET RAINSTR("FROM")="RA*5.0*196 Post-Install"

 +17       DO SENDMSG^XMXAPI(RAID,RASUB,"RATEXT",.RAREC,.RAINSTR,,)

 +18       QUIT

RAIPS196.m