ORALEAPI ; SPFO/AJB - View Alerts Optimization API ;Dec 16, 2019@06:15:40
;;3.0;ORDER ENTRY/RESULTS REPORTING;**500,518**;Dec 17, 1997;Build 11
; ^XTV(8992.1) ICR#7063
; ^VA(200) ICR#4329
; ^XMD ICR#10070
Q
POST ;
N ERROR,IEN,ORBOPT,ORXQOPT
S ORBOPT=$$LU(19,"ORB3 LM 1 MAIN MENU","X"),ORXQOPT=$$LU(19,"XQAL REPORTS MENU","X")
I '+ORBOPT!('+ORXQOPT) Q
N FDA S ORBOPT="+1,"_ORBOPT_","
S FDA(19.01,ORBOPT,.01)=ORXQOPT
S FDA(19.01,ORBOPT,2)="18"
D UPDATE^DIE("","FDA","IEN",.ERROR)
Q
RPT ;
N CSV,DATA,SAVE S CSV=1,DATA="^TMP(""ORALERT"",$J,""MSG"")"
W @IOF
W "This report will return all TIU and OE/RR notifications for the entered date",!,"range."
N DEV,DTRG S (DTRG("Start"),DTRG("Stop"))=""
D I '+DTRG("Start")!('+DTRG("Stop")) W ! Q
. N %DT,DIR,X,Y S %DT(0)=-$$DT^XLFDT,%DT="AETX",%DT("A")="Select Beginning DATE: ",%DT("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-30))
. W ! D ^%DT K %DT Q:Y<0 S DTRG("Start")=Y
. S DIR("A")=" Ending DATE: ",DIR("B")=$$FMTE^XLFDT(DT),DIR(0)="DA"_U_DTRG("Start")_":"_$$DT^XLFDT_":EXT"
. S DIR("?")=" Enter a date between "_$$FMTE^XLFDT(DTRG("Start"))_" and "_$$FMTE^XLFDT($$DT^XLFDT)_"."
. W ! D ^DIR Q:Y'>0 S DTRG("Stop")=Y S:$P(DTRG("Stop"),".",2)="" $P(DTRG("Stop"),".",2)="999999"
W ! S DEV=$$DEV Q:$S(DEV="":1,DEV="^":1,1:0)
I DEV["M" N CNT,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ D I DEV="M",'+$D(XMY) Q
. S XMSUB="Alert Tracking Report ["_$$FMTE^XLFDT(DTRG("Start"))_" to "_$$FMTE^XLFDT(DTRG("Stop"))_"]"
. S XMTEXT="^TMP(""ORALERT"",$J,""MSG"","
. S XMDUZ=DUZ,CNT=0
. D MAIL(.XMY)
I DEV["D" W ! S SAVE("*")="" D EN^XUTMDEVQ("GENERATE^ORALEAPI","Alert Tracking Report",.SAVE) Q
N ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK S ZTDTH=$H,ZTRTN="GENERATE^ORALEAPI",ZTSAVE("*")="",ZTIO="" D ^%ZTLOAD
W !!,"Mail message on its way...here is your task #: ",ZTSK,!
I $$READ^ORPARMG1("EA","Press <ENTER> to continue")
Q
GENERATE ;
K @DATA
I $E(IOST,1,2)="C-" W @IOF,"Creating report..."
D REPORT(.DATA,DTRG("Start"),DTRG("Stop"))
I $E(IOST,1,2)="C-" W "done."
I DEV["M",+$D(XMY) W:$E(IOST,1,2)="C-" !!,"Sending email..." D ^XMD W:$E(IOST,1,2)="C-" "on its way."
I DEV["D" W:$E(IOST,1,2)="C-" @IOF D I $E(IOST,1,2)="C-",$$READ^ORPARMG1("EA","Press <ENTER> to continue")
. N X S X=0 F S X=$O(@DATA@(X)) Q:'+X W @DATA@(X),!
K @DATA
Q
REPORT(ORX,SDT,EDT,TYP) ;
I $G(TYP)="OR"!($G(TYP)="TIU")!($G(TYP)="")
Q:'$T
I $G(ORX)="" S ORX="ORY"
N DELIM S DELIM=$S($D(CSV):",",1:U)
; start date[time], end date[time], type (OR/TIU)
; add ending time to EDT to ensure full day if no time
S EDT=$S($G(EDT)'="":EDT,1:$$DT^XLFDT_.99999) S:$P(EDT,".",2)="" $P(EDT,".",2)="999999"
; default starting day is EDT-30
S SDT=$S($G(SDT)'="":SDT,1:$$FMADD^XLFDT(EDT,-30))
N CNT,CRSR,GBL,IEN S CNT=0,GBL="^XTV(8992.1)" ;ICR#7063
F S SDT=$O(@GBL@("D",SDT)) Q:'+SDT!(SDT'<EDT) D
. S IEN="" F S IEN=$O(@GBL@("D",SDT,IEN)) Q:'+IEN D
. . I $G(TOTNTF)'="" S TOTNTF=TOTNTF+1 I TOTNTF=1 S CRSR=1_"^|^/^-^\^|^/^-^\" W IOCUOFF ; total notifications for ORAERPT
. . N F01,DATE,RECIPIENT,SERVICE,TIME,TITLE,TEXT S F01=$P(@GBL@(IEN,0),U) I F01["OR"!(F01["TIU") ; check alert type
. . Q:'$T ; quit if not OR/TIU alert
. . I F01["ERR" Q ; quit for TIU alert filing errors
. . I $G(TYP)'="" Q:F01'[TYP
. . N DIVISION,HLOC I F01["OR" N ORDA,ORTYP S ORDA=$$GET1^DIQ(8992.1,IEN,2),ORDA=$S(ORDA["NEW":+$P(ORDA,";",2),1:+ORDA),ORTYP=$P($P(F01,";"),",",3) D
. . . I '+ORTYP S TEXT="NOTIFICATION TYPE UNKNOWN"
. . . N NODE0 S NODE0=$G(^OR(100,ORDA,0)) I NODE0="" S DIVISION="Data Not Available"
. . . S HLOC=$$GET1^DIQ(100,ORDA,6) S:HLOC="" HLOC="Data Not Available"
. . . S:$G(DIVISION)="" DIVISION=$$GET1^DIQ(44,+$P(NODE0,U,10),3.5) S:DIVISION="" DIVISION="Data Not Available"
. . I F01["TIU" N TIUDA S TIUDA=$P($P(F01,";"),"TIU",2) D
. . . I '+TIUDA S (DIVISION,HLOC)="Data Not Available" Q
. . . I '$D(^TIU(8925,TIUDA,0)) S DIVISION="Data Not Available"
. . . S HLOC=$$GET1^DIQ(8925,TIUDA,1205) S:HLOC="" HLOC="Data Not Available"
. . . S:$G(DIVISION)="" DIVISION=$$GET1^DIQ(44,$$GET1^DIQ(8925,TIUDA,1205,"I"),3.5) S:DIVISION="" DIVISION="Data Not Available"
. . S DATE=$$FMTE^XLFDT($P(F01,";",3)),TIME=$P($P(DATE,"@",2),":",1,2),DATE=$$QM($P(DATE,"@"),$G(CSV))
. . S:$G(TEXT)="" TEXT=$S(F01["OR":$P($G(^ORD(100.9,ORTYP,0)),U,1),1:$$TIU($$GET1^DIQ(8992.1,IEN,1.01)))
. . S RECIPIENT="" F S RECIPIENT=$O(@GBL@(IEN,20,"B",RECIPIENT)) Q:'+RECIPIENT D
. . . S CNT=CNT+1 I CNT=1,$D(CSV) S @ORX@(CNT)="IEN,RECIPIENT,TITLE,SERVICE,TIME,DATE,NOTIFICATION,DIVISION,LOCATION",CNT=CNT+1
. . . S @ORX@(CNT)=IEN_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,.01),$G(CSV))_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,8),$G(CSV))_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,29),$G(CSV)) ; ICR #4329
. . . S @ORX@(CNT)=@ORX@(CNT)_DELIM_$$QM(TIME,$G(CSV))_DELIM_DATE_DELIM_$$QM(TEXT,$G(CSV))_DELIM_$$QM(DIVISION,$G(CSV))_DELIM_$$QM(HLOC,$G(CSV))
. . . I +$G(TOTNTF) I CNT#100=0 D
. . . . D IOXY^XGF(1,30) W $P(CRSR,U,+CRSR+1) S $P(CRSR,U,1)=$S(+CRSR>7:1,1:(+CRSR+1))
I +$G(TOTNTF) D IOXY^XGF(1,30) W " "
Q
DEV() ;
W !,"The report may be sent to a Device, Mail Message, or Both."
N DIRUT,DTOUT,DUOUT,DIR,X,Y
S DIR("L",1)=" (D)evice"
S DIR("L",2)=" (M)ail Message"
S DIR("L")=" (B)oth"
S DIR("A")="Enter Selection",DIR("B")="DEVICE"
S DIR(0)="SO^D:DEVICE;M:MAIL MESSAGE;B:BOTH"
D ^DIR S DEV=Y S:DEV="B" DEV="DM"
Q DEV
MAIL(XMY) ;
W !!,"The report must be sent to a DOMAIN.EXT e-mail address."
N DIRUT,DTOUT,DUOUT,DIR,X,Y
M1 S DIR(0)="FO^^K:$$LOW^XLFSTR(X)'[""domain.ext"" X"
S DIR("A")="Enter address",DIR("?")="Please enter a valid DOMAIN.EXT e-mail address or '^' to quit."
W ! D ^DIR Q:$S(Y="":1,Y="^":1,1:0) S XMY($$LOW^XLFSTR(Y))=""
D
. W !!,"Sending report to the following e-mail address: ",$O(XMY(""))
. N DIR,X,Y S DIR(0)="Y"
. S DIR("A")="Is this correct",DIR("B")="YES"
. W ! D ^DIR I $G(Y(0))="NO" K DIR,XMY G M1
Q
QM(DATA,QM) ; for excel importing as csv, replace a single double quote with two double quotes
I DATA[$C(34) N X S X("""")="""""" S DATA=$$REPLACE^XLFSTR(DATA,.X)
Q $S(+$G(QM):$C(34)_DATA_$C(34),1:DATA)
TIU(X) ;
Q $S(X["UNRELEASED":"Unreleased",X["UNSIG/UNCOS":"Unsigned/Uncosigned",X["UNSIGNED":"Unsigned",X["UNCOSIGNED":"Uncosigned",X["COMPLETED":"Additional Signature",1:"Unknown")
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"ERR")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORALEAPI 6498 printed Apr 09, 2024@21:28:36 Page 2
ORALEAPI ; SPFO/AJB - View Alerts Optimization API ;Dec 16, 2019@06:15:40
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**500,518**;Dec 17, 1997;Build 11
+2 ; ^XTV(8992.1) ICR#7063
+3 ; ^VA(200) ICR#4329
+4 ; ^XMD ICR#10070
+5 QUIT
POST ;
+1 NEW ERROR,IEN,ORBOPT,ORXQOPT
+2 SET ORBOPT=$$LU(19,"ORB3 LM 1 MAIN MENU","X")
SET ORXQOPT=$$LU(19,"XQAL REPORTS MENU","X")
+3 IF '+ORBOPT!('+ORXQOPT)
QUIT
+4 NEW FDA
SET ORBOPT="+1,"_ORBOPT_","
+5 SET FDA(19.01,ORBOPT,.01)=ORXQOPT
+6 SET FDA(19.01,ORBOPT,2)="18"
+7 DO UPDATE^DIE("","FDA","IEN",.ERROR)
+8 QUIT
RPT ;
+1 NEW CSV,DATA,SAVE
SET CSV=1
SET DATA="^TMP(""ORALERT"",$J,""MSG"")"
+2 WRITE @IOF
+3 WRITE "This report will return all TIU and OE/RR notifications for the entered date",!,"range."
+4 NEW DEV,DTRG
SET (DTRG("Start"),DTRG("Stop"))=""
+5 Begin DoDot:1
+6 NEW %DT,DIR,X,Y
SET %DT(0)=-$$DT^XLFDT
SET %DT="AETX"
SET %DT("A")="Select Beginning DATE: "
SET %DT("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-30))
+7 WRITE !
DO ^%DT
KILL %DT
if Y<0
QUIT
SET DTRG("Start")=Y
+8 SET DIR("A")=" Ending DATE: "
SET DIR("B")=$$FMTE^XLFDT(DT)
SET DIR(0)="DA"_U_DTRG("Start")_":"_$$DT^XLFDT_":EXT"
+9 SET DIR("?")=" Enter a date between "_$$FMTE^XLFDT(DTRG("Start"))_" and "_$$FMTE^XLFDT($$DT^XLFDT)_"."
+10 WRITE !
DO ^DIR
if Y'>0
QUIT
SET DTRG("Stop")=Y
if $PIECE(DTRG("Stop"),".",2)=""
SET $PIECE(DTRG("Stop"),".",2)="999999"
End DoDot:1
IF '+DTRG("Start")!('+DTRG("Stop"))
WRITE !
QUIT
+11 WRITE !
SET DEV=$$DEV
if $SELECT(DEV=""
QUIT
+12 IF DEV["M"
NEW CNT,XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
Begin DoDot:1
+13 SET XMSUB="Alert Tracking Report ["_$$FMTE^XLFDT(DTRG("Start"))_" to "_$$FMTE^XLFDT(DTRG("Stop"))_"]"
+14 SET XMTEXT="^TMP(""ORALERT"",$J,""MSG"","
+15 SET XMDUZ=DUZ
SET CNT=0
+16 DO MAIL(.XMY)
End DoDot:1
IF DEV="M"
IF '+$DATA(XMY)
QUIT
+17 IF DEV["D"
WRITE !
SET SAVE("*")=""
DO EN^XUTMDEVQ("GENERATE^ORALEAPI","Alert Tracking Report",.SAVE)
QUIT
+18 NEW ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK
SET ZTDTH=$HOROLOG
SET ZTRTN="GENERATE^ORALEAPI"
SET ZTSAVE("*")=""
SET ZTIO=""
DO ^%ZTLOAD
+19 WRITE !!,"Mail message on its way...here is your task #: ",ZTSK,!
+20 IF $$READ^ORPARMG1("EA","Press <ENTER> to continue")
+21 QUIT
GENERATE ;
+1 KILL @DATA
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF,"Creating report..."
+3 DO REPORT(.DATA,DTRG("Start"),DTRG("Stop"))
+4 IF $EXTRACT(IOST,1,2)="C-"
WRITE "done."
+5 IF DEV["M"
IF +$DATA(XMY)
if $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Sending email..."
DO ^XMD
if $EXTRACT(IOST,1,2)="C-"
WRITE "on its way."
+6 IF DEV["D"
if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
Begin DoDot:1
+7 NEW X
SET X=0
FOR
SET X=$ORDER(@DATA@(X))
if '+X
QUIT
WRITE @DATA@(X),!
End DoDot:1
IF $EXTRACT(IOST,1,2)="C-"
IF $$READ^ORPARMG1("EA","Press <ENTER> to continue")
+8 KILL @DATA
+9 QUIT
REPORT(ORX,SDT,EDT,TYP) ;
+1 IF $GET(TYP)="OR"!($GET(TYP)="TIU")!($GET(TYP)="")
+2 if '$TEST
QUIT
+3 IF $GET(ORX)=""
SET ORX="ORY"
+4 NEW DELIM
SET DELIM=$SELECT($DATA(CSV):",",1:U)
+5 ; start date[time], end date[time], type (OR/TIU)
+6 ; add ending time to EDT to ensure full day if no time
+7 SET EDT=$SELECT($GET(EDT)'="":EDT,1:$$DT^XLFDT_.99999)
if $PIECE(EDT,".",2)=""
SET $PIECE(EDT,".",2)="999999"
+8 ; default starting day is EDT-30
+9 SET SDT=$SELECT($GET(SDT)'="":SDT,1:$$FMADD^XLFDT(EDT,-30))
+10 ;ICR#7063
NEW CNT,CRSR,GBL,IEN
SET CNT=0
SET GBL="^XTV(8992.1)"
+11 FOR
SET SDT=$ORDER(@GBL@("D",SDT))
if '+SDT!(SDT'<EDT)
QUIT
Begin DoDot:1
+12 SET IEN=""
FOR
SET IEN=$ORDER(@GBL@("D",SDT,IEN))
if '+IEN
QUIT
Begin DoDot:2
+13 ; total notifications for ORAERPT
IF $GET(TOTNTF)'=""
SET TOTNTF=TOTNTF+1
IF TOTNTF=1
SET CRSR=1_"^|^/^-^\^|^/^-^\"
WRITE IOCUOFF
+14 ; check alert type
NEW F01,DATE,RECIPIENT,SERVICE,TIME,TITLE,TEXT
SET F01=$PIECE(@GBL@(IEN,0),U)
IF F01["OR"!(F01["TIU")
+15 ; quit if not OR/TIU alert
if '$TEST
QUIT
+16 ; quit for TIU alert filing errors
IF F01["ERR"
QUIT
+17 IF $GET(TYP)'=""
if F01'[TYP
QUIT
+18 NEW DIVISION,HLOC
IF F01["OR"
NEW ORDA,ORTYP
SET ORDA=$$GET1^DIQ(8992.1,IEN,2)
SET ORDA=$SELECT(ORDA["NEW":+$PIECE(ORDA,";",2),1:+ORDA)
SET ORTYP=$PIECE($PIECE(F01,";"),",",3)
Begin DoDot:3
+19 IF '+ORTYP
SET TEXT="NOTIFICATION TYPE UNKNOWN"
+20 NEW NODE0
SET NODE0=$GET(^OR(100,ORDA,0))
IF NODE0=""
SET DIVISION="Data Not Available"
+21 SET HLOC=$$GET1^DIQ(100,ORDA,6)
if HLOC=""
SET HLOC="Data Not Available"
+22 if $GET(DIVISION)=""
SET DIVISION=$$GET1^DIQ(44,+$PIECE(NODE0,U,10),3.5)
if DIVISION=""
SET DIVISION="Data Not Available"
End DoDot:3
+23 IF F01["TIU"
NEW TIUDA
SET TIUDA=$PIECE($PIECE(F01,";"),"TIU",2)
Begin DoDot:3
+24 IF '+TIUDA
SET (DIVISION,HLOC)="Data Not Available"
QUIT
+25 IF '$DATA(^TIU(8925,TIUDA,0))
SET DIVISION="Data Not Available"
+26 SET HLOC=$$GET1^DIQ(8925,TIUDA,1205)
if HLOC=""
SET HLOC="Data Not Available"
+27 if $GET(DIVISION)=""
SET DIVISION=$$GET1^DIQ(44,$$GET1^DIQ(8925,TIUDA,1205,"I"),3.5)
if DIVISION=""
SET DIVISION="Data Not Available"
End DoDot:3
+28 SET DATE=$$FMTE^XLFDT($PIECE(F01,";",3))
SET TIME=$PIECE($PIECE(DATE,"@",2),":",1,2)
SET DATE=$$QM($PIECE(DATE,"@"),$GET(CSV))
+29 if $GET(TEXT)=""
SET TEXT=$SELECT(F01["OR":$PIECE($GET(^ORD(100.9,ORTYP,0)),U,1),1:$$TIU($$GET1^DIQ(8992.1,IEN,1.01)))
+30 SET RECIPIENT=""
FOR
SET RECIPIENT=$ORDER(@GBL@(IEN,20,"B",RECIPIENT))
if '+RECIPIENT
QUIT
Begin DoDot:3
+31 SET CNT=CNT+1
IF CNT=1
IF $DATA(CSV)
SET @ORX@(CNT)="IEN,RECIPIENT,TITLE,SERVICE,TIME,DATE,NOTIFICATION,DIVISION,LOCATION"
SET CNT=CNT+1
+32 ; ICR #4329
SET @ORX@(CNT)=IEN_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,.01),$GET(CSV))_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,8),$GET(CSV))_DELIM_$$QM($$GET1^DIQ(200,RECIPIENT,29),$GET(CSV))
+33 SET @ORX@(CNT)=@ORX@(CNT)_DELIM_$$QM(TIME,$GET(CSV))_DELIM_DATE_DELIM_$$QM(TEXT,$GET(CSV))_DELIM_$$QM(DIVISION,$GET(CSV))_DELIM_$$QM(HLOC,$GET(CSV))
+34 IF +$GET(TOTNTF)
IF CNT#100=0
Begin DoDot:4
+35 DO IOXY^XGF(1,30)
WRITE $PIECE(CRSR,U,+CRSR+1)
SET $PIECE(CRSR,U,1)=$SELECT(+CRSR>7:1,1:(+CRSR+1))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+36 IF +$GET(TOTNTF)
DO IOXY^XGF(1,30)
WRITE " "
+37 QUIT
DEV() ;
+1 WRITE !,"The report may be sent to a Device, Mail Message, or Both."
+2 NEW DIRUT,DTOUT,DUOUT,DIR,X,Y
+3 SET DIR("L",1)=" (D)evice"
+4 SET DIR("L",2)=" (M)ail Message"
+5 SET DIR("L")=" (B)oth"
+6 SET DIR("A")="Enter Selection"
SET DIR("B")="DEVICE"
+7 SET DIR(0)="SO^D:DEVICE;M:MAIL MESSAGE;B:BOTH"
+8 DO ^DIR
SET DEV=Y
if DEV="B"
SET DEV="DM"
+9 QUIT DEV
MAIL(XMY) ;
+1 WRITE !!,"The report must be sent to a DOMAIN.EXT e-mail address."
+2 NEW DIRUT,DTOUT,DUOUT,DIR,X,Y
M1 SET DIR(0)="FO^^K:$$LOW^XLFSTR(X)'[""domain.ext"" X"
+1 SET DIR("A")="Enter address"
SET DIR("?")="Please enter a valid DOMAIN.EXT e-mail address or '^' to quit."
+2 WRITE !
DO ^DIR
if $SELECT(Y=""
QUIT
SET XMY($$LOW^XLFSTR(Y))=""
+3 Begin DoDot:1
+4 WRITE !!,"Sending report to the following e-mail address: ",$ORDER(XMY(""))
+5 NEW DIR,X,Y
SET DIR(0)="Y"
+6 SET DIR("A")="Is this correct"
SET DIR("B")="YES"
+7 WRITE !
DO ^DIR
IF $GET(Y(0))="NO"
KILL DIR,XMY
GOTO M1
End DoDot:1
+8 QUIT
QM(DATA,QM) ; for excel importing as csv, replace a single double quote with two double quotes
+1 IF DATA[$CHAR(34)
NEW X
SET X("""")=""""""
SET DATA=$$REPLACE^XLFSTR(DATA,.X)
+2 QUIT $SELECT(+$GET(QM):$CHAR(34)_DATA_$CHAR(34),1:DATA)
TIU(X) ;
+1 QUIT $SELECT(X["UNRELEASED":"Unreleased",X["UNSIG/UNCOS":"Unsigned/Uncosigned",X["UNSIGNED":"Unsigned",X["UNCOSIGNED":"Uncosigned",X["COMPLETED":"Additional Signature",1:"Unknown")
LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
+1 QUIT $$FIND1^DIC(FILE,"",$GET(FLAGS),NAME,$GET(INDEXES),$GET(SCREEN),"ERR")
