ORSNAST1 ;SLC/RAF - continuation of nature/status search ;10/20/00 14:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**50,190**;Dec 17, 1997
;
EN ;
S RPDT="""Report Date: "",$$FMTE^XLFDT($$NOW^XLFDT),!,""Sort Range From: "",$$FMTE^XLFDT(SDATE),"" TO: "",$$FMTE^XLFDT(EDATE)",STOP=0,PAGE=0
I SORT=1 D NATURE^ORSNAST2 Q
STATUS ;goes thru the "AF" xref in 100 for order dates for a specific status
2 I SORT=2 D I ('$D(^TMP("ORNS",$J)))&(FORMAT=1) W !,"No orders found." Q
.D:('PAGE)&(FORMAT=1) HDR^ORS100
.S DATE=SDATE F S DATE=$O(^OR(100,"AF",DATE)) Q:'DATE!STOP Q:DATE>EDATE D
..S IEN=0 F S IEN=$O(^OR(100,"AF",DATE,IEN)) Q:'IEN!STOP I $D(^OR(100,IEN)) D
...S SUB=0 F S SUB=$O(^OR(100,"AF",DATE,IEN,SUB)) Q:'SUB!STOP D
....I $P($G(^OR(100,IEN,3)),U,3)=SEARCH D
.....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),0)) S PROV=$$USER^ORS100(+$P(^OR(100,IEN,8,SUB,0),U,3))
.....I $D(^VA(200,+$P(^OR(100,IEN,0),U,4),5)),$L($P(^(5),U)) S SER=$$SER^ORS100(+$P(^VA(200,+$P(^OR(100,IEN,0),U,4),5),U))
.....E S SER="MISSING from file 200"
.....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,13))) S WHO=$$USER^ORS100(+$P(^OR(100,IEN,8,SUB,0),U,13))
.....S DFN=+$P(^OR(100,IEN,0),U,2) Q:$P(^DPT(DFN,0),U,21) D DEM^VADPT S SSN=VA("BID"),PNM=VADM(1)
.....S STATUS=$S(+$P(^OR(100,IEN,8,SUB,0),U,15)'=SEARCH&(+$P(^(0),U,15)'=0):$$STAT^ORS100(+$P(^(0),U,15)),1:$$STAT^ORS100($P(^OR(100,IEN,3),U,3)))
.....I $D(^OR(100,IEN,8,SUB,0)),$P(^(0),U) S WHEN=$$FMTE^XLFDT($P(^(0),U)) I $P(^(0),U,6) S SIGNED=$$FMTE^XLFDT($P(^(0),U,6))
.....E S SIGNED=""
.....S ^TMP("ORNS",$J,WHO,PROV,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_SIGNED
.....S ^TMP("ORSERV",$J,SER,WHO,IEN)=SER_U_WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_SIGNED
DETAILS .....;detailed output which includes the order text
.....I FORMAT=1 D
......W !,"Order STATUS: ",STATUS,?34,"Order Action: ",$P(^OR(100,IEN,8,SUB,0),U,2),?52,"ORIFN(Order #): ",IEN D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......W !,"OBJECT OF ORDER(Patient name): ",$G(PNM),?63,"SSN: ",$G(SSN) D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......I $P(^ORD(100.98,$P(^OR(100,+IEN,0),U,11),0),U)="NON-VA MEDICATIONS" D
.......W !,"DOCUMENTED BY: ",$P($G(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),0)),U),?53,"VEILED ORDER?: ",$S($P(^OR(100,IEN,3),U,8)=1:"YES",1:"NO") D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......E W !,"ORDERED BY: ",$P($G(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),0)),U),?53,"VEILED ORDER?: ",$S($P(^OR(100,IEN,3),U,8)=1:"YES",1:"NO") D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......W !,"ENTERED BY: ",$P($G(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,13),0)),U)," ON ",$$FMTE^XLFDT($P(^OR(100,IEN,0),U,7)) D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......W !,"RELEASED BY: " I +$P(^OR(100,IEN,8,SUB,0),U,16) W $P($G(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,17),0)),U)," ON ",$$FMTE^XLFDT($P(^OR(100,IEN,8,SUB,0),U,16)) D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......W !,"SIGNED BY: " I +$P(^OR(100,IEN,8,SUB,0),U,6) W $P($G(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,5),0)),U)," ON ",$$FMTE^XLFDT($P(^OR(100,IEN,8,SUB,0),U,6)) D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......W !,"ORDER TEXT: " S ORIGVIEW=2 D TEXT^ORQ12(.TEXT,IEN_";"_SUB,(IOM-13)) S TEXTSUB="" F S TEXTSUB=$O(TEXT(TEXTSUB)) Q:'+TEXTSUB!(TEXTSUB=4)!STOP W:TEXTSUB'=1 ?12 W TEXT(TEXTSUB),! D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
......I 'STOP I TEXTSUB=4 W !,"***There is more order text. It is limited to 3 lines for this report***"
......K TEXT,TEXTSUB
......I 'STOP K DASH S $P(DASH,"-",IOM)="" W !,DASH
COLUMNS ;this section uses the TMP global for the columnar format
I '$G(SERVICE)&(FORMAT=2) D
.S HDR1="!,""Provider"",?25,""Patient"",?50,""SSN"",?56,""Status"",?75,""Order #"",?87,""Order Date"",?110,""Signed"""
.S HDR="!,""Search for orders with a status of ""_SNAME"
.D HDR^ORS100
.I '$D(^TMP("ORNS",$J)) W !,"No orders found." Q
.S WHO="" F S WHO=$O(^TMP("ORNS",$J,WHO)) Q:WHO=""!STOP W "Entered by: ",WHO,! D W !
..S PNM="" F S PNM=$O(^TMP("ORNS",$J,WHO,PNM)) Q:PNM=""!STOP D
...S IEN=0 F S IEN=$O(^TMP("ORNS",$J,WHO,PNM,IEN)) Q:'IEN!STOP D
....W $P(^(IEN),U,2),?25,$P(^(IEN),U,3),?50,$P(^(IEN),U,4),?56,$P(^(IEN),U,5),?75,$P(^(IEN),U,6),?87,$P(^(IEN),U,7),?110,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORS100
SERV I $G(SERVICE)&(FORMAT=2) D
.S HDR1="!,""Provider"",?25,""Patient"",?50,""SSN"",?56,""Status"",?75,""Order #"",?87,""Order Date"",?110,""Signed"""
.S HDR="!,""Search for orders with a status of ""_SNAME"
.D HDR^ORS100
.I '$D(^TMP("ORSERV",$J)) W !,"No orders found." Q
.S REF=$S($D(LONER):"LONER(SER)",1:"^TMP(""ORSERV"",$J,SER)")
.S SER="" F S SER=$O(@REF) Q:SER=""!STOP W "Service/Section: ",SER,! D
..I '$D(^TMP("ORSERV",$J,SER)) W "No orders found.",!! Q
..S WHO="" F S WHO=$O(^TMP("ORSERV",$J,SER,WHO)) Q:WHO=""!STOP W ?5,"Entered by: ",WHO,! D W !
...S IEN=0 F S IEN=$O(^TMP("ORSERV",$J,SER,WHO,IEN)) Q:'IEN!STOP D
....W $P(^(IEN),U,3),?25,$P(^(IEN),U,4),?50,$P(^(IEN),U,5),?56,$P(^(IEN),U,6),?75,$P(^(IEN),U,7),?87,$P(^(IEN),U,8),?110,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORS100
;
K ^TMP("ORNS",$J),^TMP("ORSERV",$J)
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORSNAST1 5080 printed Oct 16, 2024@18:34:48 Page 2
ORSNAST1 ;SLC/RAF - continuation of nature/status search ;10/20/00 14:30
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50,190**;Dec 17, 1997
+2 ;
EN ;
+1 SET RPDT="""Report Date: "",$$FMTE^XLFDT($$NOW^XLFDT),!,""Sort Range From: "",$$FMTE^XLFDT(SDATE),"" TO: "",$$FMTE^XLFDT(EDATE)"
SET STOP=0
SET PAGE=0
+2 IF SORT=1
DO NATURE^ORSNAST2
QUIT
STATUS ;goes thru the "AF" xref in 100 for order dates for a specific status
2 IF SORT=2
Begin DoDot:1
+1 if ('PAGE)&(FORMAT=1)
DO HDR^ORS100
+2 SET DATE=SDATE
FOR
SET DATE=$ORDER(^OR(100,"AF",DATE))
if 'DATE!STOP
QUIT
if DATE>EDATE
QUIT
Begin DoDot:2
+3 SET IEN=0
FOR
SET IEN=$ORDER(^OR(100,"AF",DATE,IEN))
if 'IEN!STOP
QUIT
IF $DATA(^OR(100,IEN))
Begin DoDot:3
+4 SET SUB=0
FOR
SET SUB=$ORDER(^OR(100,"AF",DATE,IEN,SUB))
if 'SUB!STOP
QUIT
Begin DoDot:4
+5 IF $PIECE($GET(^OR(100,IEN,3)),U,3)=SEARCH
Begin DoDot:5
+6 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),0))
SET PROV=$$USER^ORS100(+$PIECE(^OR(100,IEN,8,SUB,0),U,3))
+7 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,0),U,4),5))
IF $LENGTH($PIECE(^(5),U))
SET SER=$$SER^ORS100(+$PIECE(^VA(200,+$PIECE(^OR(100,IEN,0),U,4),5),U))
+8 IF '$TEST
SET SER="MISSING from file 200"
+9 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,13)))
SET WHO=$$USER^ORS100(+$PIECE(^OR(100,IEN,8,SUB,0),U,13))
+10 SET DFN=+$PIECE(^OR(100,IEN,0),U,2)
if $PIECE(^DPT(DFN,0),U,21)
QUIT
DO DEM^VADPT
SET SSN=VA("BID")
SET PNM=VADM(1)
+11 SET STATUS=$SELECT(+$PIECE(^OR(100,IEN,8,SUB,0),U,15)'=SEARCH&(+$PIECE(^(0),U,15)'=0):$$STAT^ORS100(+$PIECE(^(0),U,15)),1:$$STAT^ORS100($PIECE(^OR(100,IEN,3),U,3)))
+12 IF $DATA(^OR(100,IEN,8,SUB,0))
IF $PIECE(^(0),U)
SET WHEN=$$FMTE^XLFDT($PIECE(^(0),U))
IF $PIECE(^(0),U,6)
SET SIGNED=$$FMTE^XLFDT($PIECE(^(0),U,6))
+13 IF '$TEST
SET SIGNED=""
+14 SET ^TMP("ORNS",$JOB,WHO,PROV,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_SIGNED
+15 SET ^TMP("ORSERV",$JOB,SER,WHO,IEN)=SER_U_WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_SIGNED
DETAILS ;detailed output which includes the order text
+1 IF FORMAT=1
Begin DoDot:6
+2 WRITE !,"Order STATUS: ",STATUS,?34,"Order Action: ",$PIECE(^OR(100,IEN,8,SUB,0),U,2),?52,"ORIFN(Order #): ",IEN
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+3 WRITE !,"OBJECT OF ORDER(Patient name): ",$GET(PNM),?63,"SSN: ",$GET(SSN)
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+4 IF $PIECE(^ORD(100.98,$PIECE(^OR(100,+IEN,0),U,11),0),U)="NON-VA MEDICATIONS"
Begin DoDot:7
+5 WRITE !,"DOCUMENTED BY: ",$PIECE($GET(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),0)),U),?53,"VEILED ORDER?: ",$SELECT($PIECE(^OR(100,IEN,3),U,8)=1:"YES",1:"NO")
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
End DoDot:7
+6 IF '$TEST
WRITE !,"ORDERED BY: ",$PIECE($GET(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),0)),U),?53,"VEILED ORDER?: ",$SELECT($PIECE(^OR(100,IEN,3),U,8)=1:"YES",1:"NO")
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+7 WRITE !,"ENTERED BY: ",$PIECE($GET(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,13),0)),U)," ON ",$$FMTE^XLFDT($PIECE(^OR(100,IEN,0),U,7))
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+8 WRITE !,"RELEASED BY: "
IF +$PIECE(^OR(100,IEN,8,SUB,0),U,16)
WRITE $PIECE($GET(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,17),0)),U)," ON ",$$FMTE^XLFDT($PIECE(^OR(100,IEN,8,SUB,0),U,16))
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+9 WRITE !,"SIGNED BY: "
IF +$PIECE(^OR(100,IEN,8,SUB,0),U,6)
WRITE $PIECE($GET(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,5),0)),U)," ON ",$$FMTE^XLFDT($PIECE(^OR(100,IEN,8,SUB,0),U,6))
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+10 WRITE !,"ORDER TEXT: "
SET ORIGVIEW=2
DO TEXT^ORQ12(.TEXT,IEN_";"_SUB,(IOM-13))
SET TEXTSUB=""
FOR
SET TEXTSUB=$ORDER(TEXT(TEXTSUB))
if '+TEXTSUB!(TEXTSUB=4)!STOP
QUIT
if TEXTSUB'=1
WRITE ?12
WRITE TEXT(TEXTSUB),!
if $Y>(IOSL-4)
DO HDR^ORS100
if STOP
QUIT
+11 IF 'STOP
IF TEXTSUB=4
WRITE !,"***There is more order text. It is limited to 3 lines for this report***"
+12 KILL TEXT,TEXTSUB
+13 IF 'STOP
KILL DASH
SET $PIECE(DASH,"-",IOM)=""
WRITE !,DASH
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
IF ('$DATA(^TMP("ORNS",$JOB)))&(FORMAT=1)
WRITE !,"No orders found."
QUIT
COLUMNS ;this section uses the TMP global for the columnar format
+1 IF '$GET(SERVICE)&(FORMAT=2)
Begin DoDot:1
+2 SET HDR1="!,""Provider"",?25,""Patient"",?50,""SSN"",?56,""Status"",?75,""Order #"",?87,""Order Date"",?110,""Signed"""
+3 SET HDR="!,""Search for orders with a status of ""_SNAME"
+4 DO HDR^ORS100
+5 IF '$DATA(^TMP("ORNS",$JOB))
WRITE !,"No orders found."
QUIT
+6 SET WHO=""
FOR
SET WHO=$ORDER(^TMP("ORNS",$JOB,WHO))
if WHO=""!STOP
QUIT
WRITE "Entered by: ",WHO,!
Begin DoDot:2
+7 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORNS",$JOB,WHO,PNM))
if PNM=""!STOP
QUIT
Begin DoDot:3
+8 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORNS",$JOB,WHO,PNM,IEN))
if 'IEN!STOP
QUIT
Begin DoDot:4
+9 WRITE $PIECE(^(IEN),U,2),?25,$PIECE(^(IEN),U,3),?50,$PIECE(^(IEN),U,4),?56,$PIECE(^(IEN),U,5),?75,$PIECE(^(IEN),U,6),?87,$PIECE(^(IEN),U,7),?110,$PIECE(^(IEN),U,8),!
if $Y>(IOSL-4)
DO HDR^ORS100
End DoDot:4
End DoDot:3
End DoDot:2
WRITE !
End DoDot:1
SERV IF $GET(SERVICE)&(FORMAT=2)
Begin DoDot:1
+1 SET HDR1="!,""Provider"",?25,""Patient"",?50,""SSN"",?56,""Status"",?75,""Order #"",?87,""Order Date"",?110,""Signed"""
+2 SET HDR="!,""Search for orders with a status of ""_SNAME"
+3 DO HDR^ORS100
+4 IF '$DATA(^TMP("ORSERV",$JOB))
WRITE !,"No orders found."
QUIT
+5 SET REF=$SELECT($DATA(LONER):"LONER(SER)",1:"^TMP(""ORSERV"",$J,SER)")
+6 SET SER=""
FOR
SET SER=$ORDER(@REF)
if SER=""!STOP
QUIT
WRITE "Service/Section: ",SER,!
Begin DoDot:2
+7 IF '$DATA(^TMP("ORSERV",$JOB,SER))
WRITE "No orders found.",!!
QUIT
+8 SET WHO=""
FOR
SET WHO=$ORDER(^TMP("ORSERV",$JOB,SER,WHO))
if WHO=""!STOP
QUIT
WRITE ?5,"Entered by: ",WHO,!
Begin DoDot:3
+9 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORSERV",$JOB,SER,WHO,IEN))
if 'IEN!STOP
QUIT
Begin DoDot:4
+10 WRITE $PIECE(^(IEN),U,3),?25,$PIECE(^(IEN),U,4),?50,$PIECE(^(IEN),U,5),?56,$PIECE(^(IEN),U,6),?75,$PIECE(^(IEN),U,7),?87,$PIECE(^(IEN),U,8),?110,$PIECE(^(IEN),U,9),!
if $Y>(IOSL-4)
DO HDR^ORS100
End DoDot:4
End DoDot:3
WRITE !
End DoDot:2
End DoDot:1
+11 ;
+12 KILL ^TMP("ORNS",$JOB),^TMP("ORSERV",$JOB)
+13 DO ^%ZISC
+14 QUIT
