- INHOU3 ;DP; 27 Jan 98 15:10;List Queued Tansactions.
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- Q
- QTSK ;Display currently queued entries
- K ^UTILITY($J)
- N DA,DIC,DIE,DIK
- N DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE
- I $O(^INLHSCH(""))'?1.N,$O(^INLHDEST(""))'?1.N D Q
- .W !!,"There are no entries queued for processing." Q
- S X=$J_"_"_DUZ_"_"_$P($H,",",2),DIC=4001.1,DIC(0)="L",DLAYGO=4001.1
- D ^DIC S INDA=+Y
- I +Y<0 D ERR^INHMS2("Unable to create file ") Q
- S DA=INDA,DWN="INH QUEUE LIST",DIE=4001.1
- ;Check for IHS
- I $$SC^INHUTIL1 D Q:'$D(DWFILE)
- .S DWASK="" D ^DWC
- I '$$SC^INHUTIL1 D Q:'$G(DDSSAVE)
- .N INDIC S INDIC=DIC N DIC S DIC=INDIC
- .S DDSFILE=DIE,DR="["_DWN_"]",DDSPAGE=1,DDSPARM="SC"
- .D ^DDS
- K IOP S %ZIS="N" D ^%ZIS Q:POP
- S IOP=ION_";"_IOST_";"_IOM_";"_IOSL
- N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA)
- S ZTIO=IOP I IO'=IO(0) D Q
- .S ZTRTN="QZTSK^INHOU3"
- .S ZTDESC="List of Queued Interface Transactions"
- .;N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA) S ZTSAVE("DIZ(")=""
- .S ZTSAVE("DIZ(")=""
- .S ZTSAVE("INDA")=INDA D ^%ZTLOAD
- S DA=INDA,DIK=DIC D ^DIK
- S %ZIS="" D ^%ZIS
- I POP W *7,!,"Unable to find device" D ^%ZISC Q
- ;
- QZTSK ;TaskMan entry point
- N DIOUT,DUOUT,INH,INLOOP,D0,INDX,X,Y,%
- N INDET,QUE,PRIO,PRI,DIRC,DEST,INBEG,INEND,INSEL,INQUE,DA,DES,DETL,PAG,PC,INBEG1,INE,INEND1,INH1,INLN,QUE1,COUNT
- ;Initialize variables
- ;Details
- S INDET=+$P($G(DIZ(4001.1,INDA,20)),U,3)
- ;Queue
- S QUE=$G(DIZ(4001.1,INDA,8))
- ;Priority
- S PRIO=$P($G(DIZ(4001.1,INDA,20)),U,11)
- ;Direction
- S DIRC=$G(DIZ(4001.1,INDA,6))
- ;Destination
- S DEST=$G(DIZ(4001.1,INDA,2))
- ;Start date
- S INBEG=$G(DIZ(4001.1,INDA,1))
- S:INBEG="" INBEG=$O(^INTHU("B",""))
- S:INBEG'["." INBEG=INBEG_".0"
- ;End date
- S INEND=$G(DIZ(4001.1,INDA,1.1))
- S:'$L(INEND) INEND=DT S:INEND'["." INEND=INEND_".24"
- S POP=0 D SHDR
- ;Cnvert date to $h format
- S INBEG1=$$CDATF2H^%ZTFDT(INBEG)
- S INEND1=$$CDATF2H^%ZTFDT(INEND)
- I QUE'?1N D D CLOSE Q
- .F INQUE=0,1 D @INQUE,DIPA
- I QUE=0!QUE=1 D @QUE,DIPA
- CLOSE ;Close device
- I POP D ^%ZISC Q
- F I=1:1:IOSL-$Y-3 W !
- S X="End of Report" W ?IOM-$L(X)\2,X
- D ^%ZISC
- Q
- 0 ;^INLHSCH QUEUE
- S PRI="",(POP,CNT,QUE1)=0 D HDR
- F S PRI=$O(^INLHSCH(PRI)) Q:PRI=""!POP D
- .I PRIO'="" Q:PRI>PRIO
- .S INH=INBEG1_","_($P(INBEG1,",",2)-1),D0=0
- .F S INH=$O(^INLHSCH(PRI,INH)) Q:'$L(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2) D
- ..Q:INH<INBEG1
- ..F S D0=$O(^INLHSCH(PRI,INH,D0)) Q:'D0!POP D
- ...S DETL=$G(^INTHU(D0,0)) Q:DETL=""
- ...I DIRC'="" Q:$P(DETL,U,10)'=DIRC
- ...I DEST'="" Q:$P(DETL,U,2)'=DEST
- ...S CNT=CNT+1 D DIPA
- I 'CNT S X="No entries in queue INLHSCH" W ?IOM-$L(X)\2,X,!
- I CNT S X="End of queue INLHSCH" W ?IOM-$L(X)\2,X,!
- D CR
- Q
- 1 ;^INLHDEST QUEUE
- Q:POP Q:DIRC="I"
- S DES="",(POP,CNT)=0,QUE1=1 D HDR
- F S DES=$O(^INLHDEST(DES)) Q:DES=""!POP D
- .D:$Y>(IOSL-3) HDR Q:POP
- .I DEST'="" Q:DEST'=DES
- .W !,"DESTINATION: ",$P($G(^INRHD(DES,0)),U),!
- .S PRI="" F S PRI=$O(^INLHDEST(DES,PRI)) Q:PRI=""!POP D
- ..I PRIO'="" Q:PRI>PRIO
- ..S INH=INBEG1_","_($P(INBEG1,",",2)-1),D0=0
- ..F S INH=$O(^INLHDEST(DES,PRI,INH)) Q:'$L(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2) D
- ...Q:INH<INBEG1
- ...F S D0=$O(^INLHDEST(DES,PRI,INH,D0)) Q:'D0!POP S CNT=CNT+1 D DIPA
- I 'CNT S X="No entries in queue INLDEST" W ?IOM-$L(X)\2,X,!
- I CNT S X="End of queue INLHDEST" W ?IOM-$L(X)\2,X,!
- D CR ;added by DGH for IHS port
- Q
- DIPA ;
- Q:'$G(D0) S INE=D0
- Q:'$D(^INTHU(INE,0))
- S DETL=^INTHU(INE,0)
- I 'INDET D Q
- .S INH1=$P(DETL,U)
- .W $$DATEFMT^UTDT(INH1,"MM/DD@HH:II")
- .W ?14,$E($P(DETL,U,16),1,4)
- .W ?19,$P(DETL,U,5)
- .S PC=$P(DETL,U,2),PC=$S(PC="":PC,$D(^INRHD(PC,0))#2:$P(^(0),U),1:" "_PC)
- .W ?40,$E(PC,1,35),!
- .D:$Y>(IOSL-3) HDR
- W $$DATEFMT^UTDT($P(DETL,U),"MM/DD@HH:II") K DIP
- ;PRIORITY
- W ?14,$E($P(DETL,U,16),1,4)
- ;Status
- N PC S PC=$P(DETL,U,3)
- W ?19,$S(PC="":PC,$D(INDX(PC)):INDX(PC),1:PC)
- ;ID
- W ?24,$E($P(DETL,U,5),1,18)
- ;Destination
- S PC=$P(DETL,U,2)
- S PC=$S(PC="":PC,$D(^INRHD(PC,0))#2:$P(^(0),U),1:" "_PC)
- W ?35,$E(PC,1,35)
- ;Source
- W !?35,$P(^INRHT($P(DETL,U,11),0),U)
- I $Y>(IOSL-3) D HDR Q
- W !
- Q
- ;
- SHDR ;set header
- K INLN S X=$$CDATASC^%ZTFDT($H,1,1),INLN(0)=X_" Page ",PAG=1
- S INLN(1)="List Queued Transaction Report"
- S X="From: "_$$CDATASC^%ZTFDT($E(INBEG,1,10),3,1)
- I INEND'="" D
- .S X=X_" To: "_$$CDATASC^%ZTFDT($E(INEND,1,10),3,1)
- S INLN(2)=X
- ;get the site name
- S INLN(6)=$S($D(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
- S INLN(6)=$S($P(INLN(6),U,4)]"":$P(INLN(6),U,4),1:$P(INLN(6),U,1))
- S INLN="",$P(INLN,"-",IOM+1)=""
- S INLN(7)=" Date/Time Prio Status ID Destination / Tran. Type"
- I 'INDET S INLN(7)=" Date/Time Prio ID Destination"
- D TEXT Q
- ;
- HDR ;Print header
- ;S POP=0 I $P=IO I $Y>(IOSL-4) D CR
- S POP=0 I $P(IOST,"-")["C",IO=IO(0),$Y>(IOSL-4) D CR Q:POP
- I PAG>1!($P(IOST,"-")["C") W @IOF
- W !,INLN(6)
- S X=INLN(0)_PAG,PAG=PAG+1
- W ?IOM-$L(X)-1,X,!
- F I=1,2 W !?IOM-$L(INLN(I))\2,INLN(I)
- ;S X="Queue: "_$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"ALL QUEUES")
- ;S X="Queue: "_$S($G(INQUE)=0:"INLHSCH",1:"INLHDEST")
- S X="Queue: "_$S(QUE1=0:"INLHSCH",1:"INLHDEST")
- W !?IOM-$L(X)\2,X D:'$D(INSEL) SEL
- W !,INLN(7),!,INLN,!
- Q
- CR ;
- I IO'=IO(0)!($E(IOST)="P") Q
- W !,"Press <RETURN> to continue. " R X:DTIME S:X[U POP=1
- Q
- SEL ;Display selection criteria
- W !,"Selection Criteria: "
- W !,"Queue: ",$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"All")
- W !,"Cut Off Priority: ",$S(PRIO?1.N:PRIO,1:"All")
- W !,"Direction: ",$S(DIRC="I":"In",DIRC="O":"Out",1:"All")
- W !,"Destination: ",$S(DEST="":"All",$D(^INRHD(DEST,0))#2:$P(^(0),U),1:" "_DEST)
- W !,"Detailed: ",$S(INDET=0:"No",1:"Yes"),!
- S INSEL=1
- Q
- TEXT ;Set up status array
- S INDX("A")="ACCEPT A"
- S INDX("C")="COMPLETE"
- S INDX("E")="ERROR"
- S INDX("K")="NEGATIVE"
- S INDX("N")="NEW"
- S INDX("P")="PENDING"
- S INDX("S")="SENT (Aw"
- Q
- QUE ;Select que
- I X[U!(X="^") S POP=1 Q
- N QUE1,INX S INX=X
- S X=$$UPCASE^%ZTF(X)
- S X=$S('$L(X):"",X=1:1,X=0:0,X["INLHSCH":0,X["INLHDEST":1,X="ALL":"ALL",1:2)
- I X=2 K X Q
- S QUE1=$S('$L(X):"ALL",X=0:"^INLHSCH",X=1:"^INLHDEST",1:"ALL")
- I $L(INX)=1,QUE1'=INX W " ",QUE1
- I $O(@QUE1@(""))'?.N D MESS^DWD(4) W ?10,QUE1_" is empty",!,?10,"Press <RETURN> to continue. " R X:DTIME K X
- Q
- HELP ;
- W !,"Select Queue: 0=INLHSCH"
- W !," 1=INLHDEST"
- W !!,"Press 'Enter' to select all queues"
- Q
- HELP1 ;Help text for IHS
- N INMSG
- S INMSG="Select Queue: 0=INLHSCH or 1=INLHDEST"
- D HLP^DDSUTL(.INMSG)
- Q
- ;
- DTCHK(INBEG1,INEND1,INH) ;check queue entry to see if it's in time range
- ;INBEG1=Selected start time
- ;INEND1=Selected end date/time
- ;INH=Date/time of entry in queue
- ;RETURNS -- 0 if TIME is between START and STOP
- ; -- 1 if TIME is before START
- ; -- 2 if TIME is after STOP
- Q:INH<INBEG1 1 Q:INH>INEND1 2
- Q:$P(INH,",",2)<$P(INBEG1,",",2) 1
- Q:$P(INH,",",2)>$P(INEND1,",",2) 2
- Q 0
- ;
- INHOU3 ;DP; 27 Jan 98 15:10;List Queued Tansactions.
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 QUIT
- QTSK ;Display currently queued entries
- +1 KILL ^UTILITY($JOB)
- +2 NEW DA,DIC,DIE,DIK
- +3 NEW DDSFILE,DR,DDSPAGE,DDSPARM,DDSSAVE
- +4 IF $ORDER(^INLHSCH(""))'?1.N
- IF $ORDER(^INLHDEST(""))'?1.N
- Begin DoDot:1
- +5 WRITE !!,"There are no entries queued for processing."
- QUIT
- End DoDot:1
- QUIT
- +6 SET X=$JOB_"_"_DUZ_"_"_$PIECE($HOROLOG,",",2)
- SET DIC=4001.1
- SET DIC(0)="L"
- SET DLAYGO=4001.1
- +7 DO ^DIC
- SET INDA=+Y
- +8 IF +Y<0
- DO ERR^INHMS2("Unable to create file ")
- QUIT
- +9 SET DA=INDA
- SET DWN="INH QUEUE LIST"
- SET DIE=4001.1
- +10 ;Check for IHS
- +11 IF $$SC^INHUTIL1
- Begin DoDot:1
- +12 SET DWASK=""
- DO ^DWC
- End DoDot:1
- IF '$DATA(DWFILE)
- QUIT
- +13 IF '$$SC^INHUTIL1
- Begin DoDot:1
- +14 NEW INDIC
- SET INDIC=DIC
- NEW DIC
- SET DIC=INDIC
- +15 SET DDSFILE=DIE
- SET DR="["_DWN_"]"
- SET DDSPAGE=1
- SET DDSPARM="SC"
- +16 DO ^DDS
- End DoDot:1
- IF '$GET(DDSSAVE)
- QUIT
- +17 KILL IOP
- SET %ZIS="N"
- DO ^%ZIS
- IF POP
- QUIT
- +18 SET IOP=ION_";"_IOST_";"_IOM_";"_IOSL
- +19 NEW DIZ
- MERGE DIZ(4001.1,INDA)=^DIZ(4001.1,INDA)
- +20 SET ZTIO=IOP
- IF IO'=IO(0)
- Begin DoDot:1
- +21 SET ZTRTN="QZTSK^INHOU3"
- +22 SET ZTDESC="List of Queued Interface Transactions"
- +23 ;N DIZ M DIZ(4001.1,INDA)=^DIZ(4001.1,INDA) S ZTSAVE("DIZ(")=""
- +24 SET ZTSAVE("DIZ(")=""
- +25 SET ZTSAVE("INDA")=INDA
- DO ^%ZTLOAD
- End DoDot:1
- QUIT
- +26 SET DA=INDA
- SET DIK=DIC
- DO ^DIK
- +27 SET %ZIS=""
- DO ^%ZIS
- +28 IF POP
- WRITE *7,!,"Unable to find device"
- DO ^%ZISC
- QUIT
- +29 ;
- QZTSK ;TaskMan entry point
- +1 NEW DIOUT,DUOUT,INH,INLOOP,D0,INDX,X,Y,%
- +2 NEW INDET,QUE,PRIO,PRI,DIRC,DEST,INBEG,INEND,INSEL,INQUE,DA,DES,DETL,PAG,PC,INBEG1,INE,INEND1,INH1,INLN,QUE1,COUNT
- +3 ;Initialize variables
- +4 ;Details
- +5 SET INDET=+$PIECE($GET(DIZ(4001.1,INDA,20)),U,3)
- +6 ;Queue
- +7 SET QUE=$GET(DIZ(4001.1,INDA,8))
- +8 ;Priority
- +9 SET PRIO=$PIECE($GET(DIZ(4001.1,INDA,20)),U,11)
- +10 ;Direction
- +11 SET DIRC=$GET(DIZ(4001.1,INDA,6))
- +12 ;Destination
- +13 SET DEST=$GET(DIZ(4001.1,INDA,2))
- +14 ;Start date
- +15 SET INBEG=$GET(DIZ(4001.1,INDA,1))
- +16 IF INBEG=""
- SET INBEG=$ORDER(^INTHU("B",""))
- +17 IF INBEG'["."
- SET INBEG=INBEG_".0"
- +18 ;End date
- +19 SET INEND=$GET(DIZ(4001.1,INDA,1.1))
- +20 IF '$LENGTH(INEND)
- SET INEND=DT
- IF INEND'["."
- SET INEND=INEND_".24"
- +21 SET POP=0
- DO SHDR
- +22 ;Cnvert date to $h format
- +23 SET INBEG1=$$CDATF2H^%ZTFDT(INBEG)
- +24 SET INEND1=$$CDATF2H^%ZTFDT(INEND)
- +25 IF QUE'?1N
- Begin DoDot:1
- +26 FOR INQUE=0,1
- DO @INQUE
- DO DIPA
- End DoDot:1
- DO CLOSE
- QUIT
- +27 IF QUE=0!QUE=1
- DO @QUE
- DO DIPA
- CLOSE ;Close device
- +1 IF POP
- DO ^%ZISC
- QUIT
- +2 FOR I=1:1:IOSL-$Y-3
- WRITE !
- +3 SET X="End of Report"
- WRITE ?IOM-$LENGTH(X)\2,X
- +4 DO ^%ZISC
- +5 QUIT
- 0 ;^INLHSCH QUEUE
- +1 SET PRI=""
- SET (POP,CNT,QUE1)=0
- DO HDR
- +2 FOR
- SET PRI=$ORDER(^INLHSCH(PRI))
- IF PRI=""!POP
- QUIT
- Begin DoDot:1
- +3 IF PRIO'=""
- IF PRI>PRIO
- QUIT
- +4 SET INH=INBEG1_","_($PIECE(INBEG1,",",2)-1)
- SET D0=0
- +5 FOR
- SET INH=$ORDER(^INLHSCH(PRI,INH))
- IF '$LENGTH(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2)
- QUIT
- Begin DoDot:2
- +6 IF INH<INBEG1
- QUIT
- +7 FOR
- SET D0=$ORDER(^INLHSCH(PRI,INH,D0))
- IF 'D0!POP
- QUIT
- Begin DoDot:3
- +8 SET DETL=$GET(^INTHU(D0,0))
- IF DETL=""
- QUIT
- +9 IF DIRC'=""
- IF $PIECE(DETL,U,10)'=DIRC
- QUIT
- +10 IF DEST'=""
- IF $PIECE(DETL,U,2)'=DEST
- QUIT
- +11 SET CNT=CNT+1
- DO DIPA
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 IF 'CNT
- SET X="No entries in queue INLHSCH"
- WRITE ?IOM-$LENGTH(X)\2,X,!
- +13 IF CNT
- SET X="End of queue INLHSCH"
- WRITE ?IOM-$LENGTH(X)\2,X,!
- +14 DO CR
- +15 QUIT
- 1 ;^INLHDEST QUEUE
- +1 IF POP
- QUIT
- IF DIRC="I"
- QUIT
- +2 SET DES=""
- SET (POP,CNT)=0
- SET QUE1=1
- DO HDR
- +3 FOR
- SET DES=$ORDER(^INLHDEST(DES))
- IF DES=""!POP
- QUIT
- Begin DoDot:1
- +4 IF $Y>(IOSL-3)
- DO HDR
- IF POP
- QUIT
- +5 IF DEST'=""
- IF DEST'=DES
- QUIT
- +6 WRITE !,"DESTINATION: ",$PIECE($GET(^INRHD(DES,0)),U),!
- +7 SET PRI=""
- FOR
- SET PRI=$ORDER(^INLHDEST(DES,PRI))
- IF PRI=""!POP
- QUIT
- Begin DoDot:2
- +8 IF PRIO'=""
- IF PRI>PRIO
- QUIT
- +9 SET INH=INBEG1_","_($PIECE(INBEG1,",",2)-1)
- SET D0=0
- +10 FOR
- SET INH=$ORDER(^INLHDEST(DES,PRI,INH))
- IF '$LENGTH(INH)!POP!($$DTCHK(INBEG1,INEND1,INH)=2)
- QUIT
- Begin DoDot:3
- +11 IF INH<INBEG1
- QUIT
- +12 FOR
- SET D0=$ORDER(^INLHDEST(DES,PRI,INH,D0))
- IF 'D0!POP
- QUIT
- SET CNT=CNT+1
- DO DIPA
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 IF 'CNT
- SET X="No entries in queue INLDEST"
- WRITE ?IOM-$LENGTH(X)\2,X,!
- +14 IF CNT
- SET X="End of queue INLHDEST"
- WRITE ?IOM-$LENGTH(X)\2,X,!
- +15 ;added by DGH for IHS port
- DO CR
- +16 QUIT
- DIPA ;
- +1 IF '$GET(D0)
- QUIT
- SET INE=D0
- +2 IF '$DATA(^INTHU(INE,0))
- QUIT
- +3 SET DETL=^INTHU(INE,0)
- +4 IF 'INDET
- Begin DoDot:1
- +5 SET INH1=$PIECE(DETL,U)
- +6 WRITE $$DATEFMT^UTDT(INH1,"MM/DD@HH:II")
- +7 WRITE ?14,$EXTRACT($PIECE(DETL,U,16),1,4)
- +8 WRITE ?19,$PIECE(DETL,U,5)
- +9 SET PC=$PIECE(DETL,U,2)
- SET PC=$SELECT(PC="":PC,$DATA(^INRHD(PC,0))#2:$PIECE(^(0),U),1:" "_PC)
- +10 WRITE ?40,$EXTRACT(PC,1,35),!
- +11 IF $Y>(IOSL-3)
- DO HDR
- End DoDot:1
- QUIT
- +12 WRITE $$DATEFMT^UTDT($PIECE(DETL,U),"MM/DD@HH:II")
- KILL DIP
- +13 ;PRIORITY
- +14 WRITE ?14,$EXTRACT($PIECE(DETL,U,16),1,4)
- +15 ;Status
- +16 NEW PC
- SET PC=$PIECE(DETL,U,3)
- +17 WRITE ?19,$SELECT(PC="":PC,$DATA(INDX(PC)):INDX(PC),1:PC)
- +18 ;ID
- +19 WRITE ?24,$EXTRACT($PIECE(DETL,U,5),1,18)
- +20 ;Destination
- +21 SET PC=$PIECE(DETL,U,2)
- +22 SET PC=$SELECT(PC="":PC,$DATA(^INRHD(PC,0))#2:$PIECE(^(0),U),1:" "_PC)
- +23 WRITE ?35,$EXTRACT(PC,1,35)
- +24 ;Source
- +25 WRITE !?35,$PIECE(^INRHT($PIECE(DETL,U,11),0),U)
- +26 IF $Y>(IOSL-3)
- DO HDR
- QUIT
- +27 WRITE !
- +28 QUIT
- +29 ;
- SHDR ;set header
- +1 KILL INLN
- SET X=$$CDATASC^%ZTFDT($HOROLOG,1,1)
- SET INLN(0)=X_" Page "
- SET PAG=1
- +2 SET INLN(1)="List Queued Transaction Report"
- +3 SET X="From: "_$$CDATASC^%ZTFDT($EXTRACT(INBEG,1,10),3,1)
- +4 IF INEND'=""
- Begin DoDot:1
- +5 SET X=X_" To: "_$$CDATASC^%ZTFDT($EXTRACT(INEND,1,10),3,1)
- End DoDot:1
- +6 SET INLN(2)=X
- +7 ;get the site name
- +8 SET INLN(6)=$SELECT($DATA(^DIC(4,^DD("SITE",1),0)):^(0),1:^DD("SITE"))
- +9 SET INLN(6)=$SELECT($PIECE(INLN(6),U,4)]"":$PIECE(INLN(6),U,4),1:$PIECE(INLN(6),U,1))
- +10 SET INLN=""
- SET $PIECE(INLN,"-",IOM+1)=""
- +11 SET INLN(7)=" Date/Time Prio Status ID Destination / Tran. Type"
- +12 IF 'INDET
- SET INLN(7)=" Date/Time Prio ID Destination"
- +13 DO TEXT
- QUIT
- +14 ;
- HDR ;Print header
- +1 ;S POP=0 I $P=IO I $Y>(IOSL-4) D CR
- +2 SET POP=0
- IF $PIECE(IOST,"-")["C"
- IF IO=IO(0)
- IF $Y>(IOSL-4)
- DO CR
- IF POP
- QUIT
- +3 IF PAG>1!($PIECE(IOST,"-")["C")
- WRITE @IOF
- +4 WRITE !,INLN(6)
- +5 SET X=INLN(0)_PAG
- SET PAG=PAG+1
- +6 WRITE ?IOM-$LENGTH(X)-1,X,!
- +7 FOR I=1,2
- WRITE !?IOM-$LENGTH(INLN(I))\2,INLN(I)
- +8 ;S X="Queue: "_$S(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"ALL QUEUES")
- +9 ;S X="Queue: "_$S($G(INQUE)=0:"INLHSCH",1:"INLHDEST")
- +10 SET X="Queue: "_$SELECT(QUE1=0:"INLHSCH",1:"INLHDEST")
- +11 WRITE !?IOM-$LENGTH(X)\2,X
- IF '$DATA(INSEL)
- DO SEL
- +12 WRITE !,INLN(7),!,INLN,!
- +13 QUIT
- CR ;
- +1 IF IO'=IO(0)!($EXTRACT(IOST)="P")
- QUIT
- +2 WRITE !,"Press <RETURN> to continue. "
- READ X:DTIME
- IF X[U
- SET POP=1
- +3 QUIT
- SEL ;Display selection criteria
- +1 WRITE !,"Selection Criteria: "
- +2 WRITE !,"Queue: ",$SELECT(QUE=0:"INLHSCH",QUE=1:"INLHDEST",1:"All")
- +3 WRITE !,"Cut Off Priority: ",$SELECT(PRIO?1.N:PRIO,1:"All")
- +4 WRITE !,"Direction: ",$SELECT(DIRC="I":"In",DIRC="O":"Out",1:"All")
- +5 WRITE !,"Destination: ",$SELECT(DEST="":"All",$DATA(^INRHD(DEST,0))#2:$PIECE(^(0),U),1:" "_DEST)
- +6 WRITE !,"Detailed: ",$SELECT(INDET=0:"No",1:"Yes"),!
- +7 SET INSEL=1
- +8 QUIT
- TEXT ;Set up status array
- +1 SET INDX("A")="ACCEPT A"
- +2 SET INDX("C")="COMPLETE"
- +3 SET INDX("E")="ERROR"
- +4 SET INDX("K")="NEGATIVE"
- +5 SET INDX("N")="NEW"
- +6 SET INDX("P")="PENDING"
- +7 SET INDX("S")="SENT (Aw"
- +8 QUIT
- QUE ;Select que
- +1 IF X[U!(X="^")
- SET POP=1
- QUIT
- +2 NEW QUE1,INX
- SET INX=X
- +3 SET X=$$UPCASE^%ZTF(X)
- +4 SET X=$SELECT('$LENGTH(X):"",X=1:1,X=0:0,X["INLHSCH":0,X["INLHDEST":1,X="ALL":"ALL",1:2)
- +5 IF X=2
- KILL X
- QUIT
- +6 SET QUE1=$SELECT('$LENGTH(X):"ALL",X=0:"^INLHSCH",X=1:"^INLHDEST",1:"ALL")
- +7 IF $LENGTH(INX)=1
- IF QUE1'=INX
- WRITE " ",QUE1
- +8 IF $ORDER(@QUE1@(""))'?.N
- DO MESS^DWD(4)
- WRITE ?10,QUE1_" is empty",!,?10,"Press <RETURN> to continue. "
- READ X:DTIME
- KILL X
- +9 QUIT
- HELP ;
- +1 WRITE !,"Select Queue: 0=INLHSCH"
- +2 WRITE !," 1=INLHDEST"
- +3 WRITE !!,"Press 'Enter' to select all queues"
- +4 QUIT
- HELP1 ;Help text for IHS
- +1 NEW INMSG
- +2 SET INMSG="Select Queue: 0=INLHSCH or 1=INLHDEST"
- +3 DO HLP^DDSUTL(.INMSG)
- +4 QUIT
- +5 ;
- DTCHK(INBEG1,INEND1,INH) ;check queue entry to see if it's in time range
- +1 ;INBEG1=Selected start time
- +2 ;INEND1=Selected end date/time
- +3 ;INH=Date/time of entry in queue
- +4 ;RETURNS -- 0 if TIME is between START and STOP
- +5 ; -- 1 if TIME is before START
- +6 ; -- 2 if TIME is after STOP
- +7 IF INH<INBEG1
- QUIT 1
- IF INH>INEND1
- QUIT 2
- +8 IF $PIECE(INH,",",2)<$PIECE(INBEG1,",",2)
- QUIT 1
- +9 IF $PIECE(INH,",",2)>$PIECE(INEND1,",",2)
- QUIT 2
- +10 QUIT 0
- +11 ;
