- ORSNAST2 ;SLC/RAF - continuation of nature/status search ; 9/13/11 6:56am
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50,190,347**;Dec 17, 1997;Build 4
- ;
- NATURE ;goes thru the "AF" xref in 100 for order dates for nature or order
- 1 I SORT=1 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
- ...;*347 We only want to check the current action
- ...S SUB=$$GET1^DIQ(100,IEN,30,"I") Q:'SUB!STOP D
- ....I $P($G(^OR(100,IEN,8,SUB,0)),U,12)=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)
- .....I $D(^OR(100,IEN,3)),$P(^(3),U,3) S STATUS=$$STAT^ORS100(+$P(^(3),U,3))
- .....I $D(^OR(100,IEN,8,SUB,0)) S WHEN=$$FMTE^XLFDT($P(^(0),U)) 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 !,"NATURE OF ORDER: ",SNAME,?54,"Order Action: ",$P(^OR(100,IEN,8,SUB,0),U,2) D:$Y>(IOSL-4) HDR^ORS100 Q:STOP
- ......W !,"STATUS: ",STATUS,?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 nature of order 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 nature of order 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
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORSNAST2 4886 printed Feb 19, 2025@00:00:47 Page 2
- ORSNAST2 ;SLC/RAF - continuation of nature/status search ; 9/13/11 6:56am
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50,190,347**;Dec 17, 1997;Build 4
- +2 ;
- NATURE ;goes thru the "AF" xref in 100 for order dates for nature or order
- 1 IF SORT=1
- 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 ;*347 We only want to check the current action
- +5 SET SUB=$$GET1^DIQ(100,IEN,30,"I")
- if 'SUB!STOP
- QUIT
- Begin DoDot:4
- +6 IF $PIECE($GET(^OR(100,IEN,8,SUB,0)),U,12)=SEARCH
- Begin DoDot:5
- +7 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))
- +8 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))
- +9 IF '$TEST
- SET SER="MISSING from file 200"
- +10 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))
- +11 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)
- +12 IF $DATA(^OR(100,IEN,3))
- IF $PIECE(^(3),U,3)
- SET STATUS=$$STAT^ORS100(+$PIECE(^(3),U,3))
- +13 IF $DATA(^OR(100,IEN,8,SUB,0))
- SET WHEN=$$FMTE^XLFDT($PIECE(^(0),U))
- SET SIGNED=$$FMTE^XLFDT($PIECE(^(0),U,6))
- +14 IF '$TEST
- SET SIGNED=""
- +15 SET ^TMP("ORNS",$JOB,WHO,PROV,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_SIGNED
- +16 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 !,"NATURE OF ORDER: ",SNAME,?54,"Order Action: ",$PIECE(^OR(100,IEN,8,SUB,0),U,2)
- if $Y>(IOSL-4)
- DO HDR^ORS100
- if STOP
- QUIT
- +3 WRITE !,"STATUS: ",STATUS,?52,"ORIFN(Order #): ",IEN
- if $Y>(IOSL-4)
- DO HDR^ORS100
- if STOP
- QUIT
- +4 WRITE !,"OBJECT OF ORDER(Patient name): ",$GET(PNM),?63,"SSN: ",$GET(SSN)
- if $Y>(IOSL-4)
- DO HDR^ORS100
- if STOP
- QUIT
- +5 IF $PIECE(^ORD(100.98,$PIECE(^OR(100,+IEN,0),U,11),0),U)="NON-VA MEDICATIONS"
- Begin DoDot:7
- +6 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
- +7 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
- +8 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
- +9 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
- +10 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
- +11 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
- +12 IF 'STOP
- IF TEXTSUB=4
- WRITE !,"***There is more order text. It is limited to 3 lines for this report***"
- +13 KILL TEXT,TEXTSUB
- +14 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 nature of order 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 nature of order 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 QUIT
