Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHOU4

INHOU4.m

Go to the documentation of this file. 
  1. INHOU4 ;DP; 25 Jun 97 10:42;Mark transaction complete. 
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q
  1.  ;
  1. MC ;Mark as complete (need INH MESSAGE EDIT key to do this)
  1.  N DIC,INTT,UIF,DWFILE,Y,DES,INHERR,SUBDELIM,CU,DIOUT,DIPA,DIRCP,DIRI,DLAYGO,DIRMAX,HDR,I,INDA,INFO,INH,INQUIT,INREQLST,INZ,J,K,OK,PRIO,POP,QUE,OD,INMID,INPARM2,INL,%ZIS
  1.  D CLEAR^DW
  1.  S INPARM2("LIST","HOT",1)="PROCESS^H1"
  1.  S INPARM2("LIST","HOT",1,"ACTION")="D LOOP^INHOU4(.DWLMK,DWLRF),DISP^INHOU4(.DWLMK,DWLRF)"
  1. EN2 S X="** Mark Transaction Complete **" W !?80-$L(X)/2,X,!! K X
  1.  D ^UTSRD("Select Transaction to Mark Complete: ;;;;;","Search Queue:/, or a Valid Message ID")
  1.  ; handle the different error/exit conditions
  1.  G:X="" EXIT1
  1.  I X="/" S POP=0 D  I POP D CLEAR^DW G EXIT1
  1.  .S INQUIT=$$TIEN^INHUTC(.INPARM2,"INREQLST")
  1.  .S:'$D(INREQLST) POP=1
  1.  I X="^"!(X="") Q
  1.  ; let DIC handle all other input checks for single message reque
  1.  I '$D(INREQLST) D  Q:'$D(INREQLST)
  1.  .S DIC="^INTHU(",DIC(0)="M" D ^DIC
  1.  .I Y<0 W *7,"No such transaction on file!." D CONT Q
  1.  .S INREQLST(1)=1,INL(1)="",INL(1,0)=+Y
  1.  D LOOP(.INREQLST,"INL")
  1.  G EN2
  1.  ;
  1. EXIT1 D:$D(INDA) INKINDA^INHMS(INDA) Q
  1.  ;
  1. LOOP(INREQLST,DWLRF) ;Loop to process transactions selected by user
  1.  N INQUIT
  1.  S CU="",HDR="*** Mark Transaction Complete ***"
  1.  S INQUIT=0 F  S CU=$O(INREQLST(CU)) Q:CU=""!INQUIT  D
  1.  .S UIF=$G(@DWLRF@(CU,0)) Q:'UIF
  1.  .S INFO=$G(^INTHU(UIF,0)),PRIO=+$P(INFO,U,16),INH=$P(INFO,U,19),DES=$P(INFO,U,2),INMID=$P(INFO,U,5) S:'$L(INH) INH=0
  1.  .D
  1.  ..;Find what queue it is really on
  1.  ..I $D(^INLHSCH(PRIO,INH,UIF)) S QUE=0 Q
  1.  ..I $D(^INLHDEST(DES,PRIO,INH,UIF)) S QUE=1 Q
  1.  ..;Otherwise it is not on any queue
  1.  ..S QUE=""
  1.  .;If its on a queue, prompt
  1.  .I $L(QUE) D
  1.  ..W @IOF,?80-$L(HDR)/2,HDR,!!
  1.  ..W ?52,"Que: ",$S(QUE=1:"^INLHDEST",QUE=0:"^INLHSCH",1:"Not queued"),!
  1.  ..K DIPA S D0=UIF
  1.  ..S SUBDELIM="\",DIPA(D0)=INH D ^INXHR01
  1.  .I QUE="" D COMP S $P(INREQLST(CU),U,2)=INMID_": Not queued, marked complete" Q
  1.  .S OD="OK to delete from queue"
  1.  .W ! S OK=$$YN^UTSRD(OD_" ?: ;Y") S:OK["^" INQUIT=1 I 'OK D  Q
  1.  ..S $P(INREQLST(CU),U,2)=INMID_": Not marked complete"
  1.  .K ^INLHSCH(PRIO,INH,UIF),^INLHDEST(DES,PRIO,INH,UIF) D COMP
  1.  .S $P(INREQLST(CU),U,2)=INMID_": Removed from queue, marked complete"
  1.  Q
  1.  ;
  1. EXIT Q
  1.  ;
  1. COMP ;Successful processing
  1.  D ULOG^INHU(UIF,"C","Marked complete by user "_$P(^DIC(3,DUZ,0),U))
  1.  Q
  1.  ;
  1. DISP(INLIST1,INLIST2) ; Display results of all items selected
  1.  ;Loop through selection list and display items.
  1.  ; INPUT
  1.  ; INLIST1 = The array of user selected items with piece 2 = action
  1.  ; INLIST2 = The full array from the list processor
  1.  N INNODE
  1.  S %ZIS="" D CLEAR^DW,^%ZIS U IO I IO=$P W @IOF
  1.  S POP=0
  1.  S INNODE="" F  S INNODE=$O(INLIST1(INNODE)) Q:'INNODE!POP  D
  1.  .;if second piece is null, user enter "^". Take no action
  1.  .Q:'$L($P(INLIST1(INNODE),U,2))
  1.  .I $Y>(IOSL-4) D CONT Q:POP
  1.  .W !,$P(INLIST1(INNODE),U,2)
  1.  .K INLIST1(INNODE),@INLIST2@(INNODE)
  1.  K INLIST1
  1.  D CONT
  1.  D ^%ZISC S IOP="",%ZIS="" D ^%ZIS U IO K IO("Q"),IOP,POP
  1.  Q
  1.  ;
  1. CONT I IO=IO(0),$E(IOST)'="P" W ! S X=$$CR^UTSRD I X S POP=1 Q
  1.  W @IOF
  1.  Q