INHUTC52 ;DGH Search using VA list manager
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;
;
EN(INSRCH) ; -- option entry point
K XQORS,VALMEVL
;If the array exists, call the protocol that allows selection
I INSRCH("TYPE")="TRANSACTION",$G(INOPT("ARRAY"))["INREQLST" D EN^VALM("INH TRANSACTION SELECT") Q
I INSRCH("TYPE")="TRANSACTION" D EN^VALM("INH TRANSACTION SEARCH") Q
I INSRCH("TYPE")="ERROR" D EN^VALM("INH ERROR SEARCH")
Q
;
;
FIND ;Entry point called from within VA List Manager
;Stack VALM variables, then call existing GIS search point.
N VALMX,VALMCNTI
S (VALMCNT,VALMCNTI)=0
D CLEAN^VALM10
D FIND^INHUTC5(.INQUIT,.INOPT,"",.INSRCH)
Q
;
SETTMP(INIEN,INSRCH) ;Set ^TMP global for records that match selection crit.
;called from FIND^INHUTC5
;VALM function seems to require that VALMCNT be the counter
;It is incremented in the calling routine
N INDEST,INDSTNUM,INTR,INTRN,INX,INSTAT,INLOC,INWID
S VALMCNT=INSRCH("INFNDCT")
I INSRCH("TYPE")="TRANSACTION" D
.S VALMX=^INTHU(INIEN,0)
.S VALMCNTI=VALMCNTI+1
.S X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
.S X=$$SETFLD^VALM1($TR($$CDATASC^%ZTFDT($P(VALMX,U),1,2),":"),X,"DATE/TIME")
.S X=$$SETFLD^VALM1($P(VALMX,U,5),X,"MESSAGE ID")
.S INDSTNUM=+$P(VALMX,U,2),INDEST=$S(INDSTNUM:$P($G(^INRHD(INDSTNUM,0)),U),1:""),X=$$SETFLD^VALM1(INDEST,X,"DESTINATION")
.Q ;Don't do expanded display now
.;patient
.S INTMP=$$INMSPAT^INHMS1(INIEN,"",.INPATNAM)
.S X=$$SETFLD^VALM1(INPATNAM,X,"PATIENT")
.;Transaction
.S INTRN=+$P(VALMX,U,11),INTR=$S(INTRN:$P($G(^INRHT(INTRN,0)),U),1:""),X=$$SETFLD^VALM1(INTR,X,"TRANSACTION")
I INSRCH("TYPE")="ERROR" D
.S VALMX=^INTHER(INIEN,0)
.S VALMCNTI=VALMCNTI+1
.S X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
.S X=$$SETFLD^VALM1($TR($$CDATASC^%ZTFDT($P(VALMX,U),1,2),":"),X,"DATE/TIME")
.S INSTAT=$P(VALMX,U,10)
.S INSTAT=$S($L(INSTAT):INSRCH("INETBL",+INSTAT),1:"none")
.S X=$$SETFLD^VALM1(INSTAT,X,"STATUS")
.S INLOC=$S(+$P(VALMX,U,5):+$P(VALMX,U,5),1:"none")
.S:+INLOC INLOC=$P($G(^INTHERL(INLOC,0)),U)
.S X=$$SETFLD^VALM1(INLOC,X,"LOCATION")
;Width needs to be variable if called from different screens with
;differing total widths. Set at 79 for now
S INWID=77
K Z S $P(Z,$E(VALMCNTI),INWID)=""
D SET^VALM10(VALMCNT,$E(X_Z,1,INWID),VALMCNTI) ; set text
S ^TMP("INSRCH",$J,VALMCNTI)=VALMCNT_U_INIEN
D:'(VALMCNT#9) FLDCTRL^VALM10(VALMCNT) ; defaults for all fields
D FLDCTRL^VALM10(VALMCNT,"NUMBER") ; default for 1 field
;D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"NAME",IOUON,IOUOFF) ; adhoc
D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"DATE/TIME",IOUON,IOUOFF) ;adhoc
D NUL:'VALMCNT
Q
;
HDR ; -- header
;N VALMX
;S VALMX=$G(^DIC(9.4,VALMPKG,0)),X=" Package: "_$P(VALMX,U)
;S VALMHDR(1)=$$SETSTR^VALM1("Prefix: "_$P(VALMX,U,2),X,63,15)
;S VALMHDR(2)="Description: "_$E($P(VALMX,U,3),1,65)
N MSG S MSG="Interface "_$S(INSRCH("TYPE")="ERROR":"Error",1:"Transaction")_" Search"
S X="",VALMHDR(1)=$$SETSTR^VALM1(MSG,X,26,29) Q
;
NUL ; -- set nul message
I 'VALMCNT D
.F X=" "," No matching records." S VALMCNT=VALMCNT+1 D SET^VALM10(VALMCNT,X)
.S ^TMP("INSRCH",$J,1)=1,^(2)=2
Q
;
FNL ; -- clean up
K DIE,DIC,DR,DA,DE,DQ,VALMY,VALMPKG,^TMP("INSRCH",$J)
D CLEAN^VALM10
Q
;
EXP ; -- expand action
D FULL^VALM1
N VALMI,VALMAT,VALMY
D EN^VALM2(XQORNOD(0),"O") S VALMI=0
F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
.S VALMAT=$G(^TMP("INSRCH",$J,VALMI))
.W !!,@VALMAR@(+VALMAT,0),!
.I INSRCH("TYPE")="TRANSACTION" S DIC="^INTHU(",DR="0;1;3"
.I INSRCH("TYPE")="ERROR" S DIC="^INTHER(",DR="0;1;2"
.S DA=+$P(VALMAT,U,2) D EN^DIQ,PAUSE^VALM1
S VALMBCK="R",VALMSG="'Expand' was last action picked."
Q
;
SEL ; Set selected item into array
;I $G(INOPT("ARRAY"))'["INREQLST" D EXP S VALMSG="'Select' was last action picked." Q
N VALMI,VALMAT,VALMY,INNUM
D EN^VALM2(XQORNOD(0),"O") S VALMI=0
F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
.S VALMAT=$G(^TMP("INSRCH",$J,VALMI))
.W !!,@VALMAR@(+VALMAT,0),!
.S INNUM=+VALMAT,DA=+$P(VALMAT,U,2)
.;ARRAY will be set for MTC and REQUEUE functions
.I $G(INOPT("ARRAY"))["INREQLST" D Q
..;CHCS listman returns array in DWLMK. GIS expects this
..S DWLMK(INNUM)=""
..;CHCS listman has @DWLRF array that must be populated.
..;It is usually INL
..S:'$D(DWLRF) DWLRF="INL"
..S @DWLRF@(INNUM)="",@DWLRF@(INNUM,0)=DA
..S VALMSG=$P($G(^INTHU(DA,0)),U,5)_" selected for processing."
;
S VALMBCK="R"
Q
;
UPD(TEXT,FLD,VALMAT) ; -- update data for screen
D:VALMCC FLDCTRL^VALM10(+VALMAT,.FLD,.IOINHI,.IOINORM,1)
D FLDTEXT^VALM10(+VALMAT,.FLD,.TEXT)
Q
;
;
INHUTC52 ;DGH Search using VA list manager
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;
+5 ;
EN(INSRCH) ; -- option entry point
+1 KILL XQORS,VALMEVL
+2 ;If the array exists, call the protocol that allows selection
+3 IF INSRCH("TYPE")="TRANSACTION"
IF $GET(INOPT("ARRAY"))["INREQLST"
DO EN^VALM("INH TRANSACTION SELECT")
QUIT
+4 IF INSRCH("TYPE")="TRANSACTION"
DO EN^VALM("INH TRANSACTION SEARCH")
QUIT
+5 IF INSRCH("TYPE")="ERROR"
DO EN^VALM("INH ERROR SEARCH")
+6 QUIT
+7 ;
+8 ;
FIND ;Entry point called from within VA List Manager
+1 ;Stack VALM variables, then call existing GIS search point.
+2 NEW VALMX,VALMCNTI
+3 SET (VALMCNT,VALMCNTI)=0
+4 DO CLEAN^VALM10
+5 DO FIND^INHUTC5(.INQUIT,.INOPT,"",.INSRCH)
+6 QUIT
+7 ;
SETTMP(INIEN,INSRCH) ;Set ^TMP global for records that match selection crit.
+1 ;called from FIND^INHUTC5
+2 ;VALM function seems to require that VALMCNT be the counter
+3 ;It is incremented in the calling routine
+4 NEW INDEST,INDSTNUM,INTR,INTRN,INX,INSTAT,INLOC,INWID
+5 SET VALMCNT=INSRCH("INFNDCT")
+6 IF INSRCH("TYPE")="TRANSACTION"
Begin DoDot:1
+7 SET VALMX=^INTHU(INIEN,0)
+8 SET VALMCNTI=VALMCNTI+1
+9 SET X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
+10 SET X=$$SETFLD^VALM1($TRANSLATE($$CDATASC^%ZTFDT($PIECE(VALMX,U),1,2),":"),X,"DATE/TIME")
+11 SET X=$$SETFLD^VALM1($PIECE(VALMX,U,5),X,"MESSAGE ID")
+12 SET INDSTNUM=+$PIECE(VALMX,U,2)
SET INDEST=$SELECT(INDSTNUM:$PIECE($GET(^INRHD(INDSTNUM,0)),U),1:"")
SET X=$$SETFLD^VALM1(INDEST,X,"DESTINATION")
+13 ;Don't do expanded display now
QUIT
+14 ;patient
+15 SET INTMP=$$INMSPAT^INHMS1(INIEN,"",.INPATNAM)
+16 SET X=$$SETFLD^VALM1(INPATNAM,X,"PATIENT")
+17 ;Transaction
+18 SET INTRN=+$PIECE(VALMX,U,11)
SET INTR=$SELECT(INTRN:$PIECE($GET(^INRHT(INTRN,0)),U),1:"")
SET X=$$SETFLD^VALM1(INTR,X,"TRANSACTION")
End DoDot:1
+19 IF INSRCH("TYPE")="ERROR"
Begin DoDot:1
+20 SET VALMX=^INTHER(INIEN,0)
+21 SET VALMCNTI=VALMCNTI+1
+22 SET X=$$SETFLD^VALM1(VALMCNTI,"","NUMBER")
+23 SET X=$$SETFLD^VALM1($TRANSLATE($$CDATASC^%ZTFDT($PIECE(VALMX,U),1,2),":"),X,"DATE/TIME")
+24 SET INSTAT=$PIECE(VALMX,U,10)
+25 SET INSTAT=$SELECT($LENGTH(INSTAT):INSRCH("INETBL",+INSTAT),1:"none")
+26 SET X=$$SETFLD^VALM1(INSTAT,X,"STATUS")
+27 SET INLOC=$SELECT(+$PIECE(VALMX,U,5):+$PIECE(VALMX,U,5),1:"none")
+28 IF +INLOC
SET INLOC=$PIECE($GET(^INTHERL(INLOC,0)),U)
+29 SET X=$$SETFLD^VALM1(INLOC,X,"LOCATION")
End DoDot:1
+30 ;Width needs to be variable if called from different screens with
+31 ;differing total widths. Set at 79 for now
+32 SET INWID=77
+33 KILL Z
SET $PIECE(Z,$EXTRACT(VALMCNTI),INWID)=""
+34 ; set text
DO SET^VALM10(VALMCNT,$EXTRACT(X_Z,1,INWID),VALMCNTI)
+35 SET ^TMP("INSRCH",$JOB,VALMCNTI)=VALMCNT_U_INIEN
+36 ; defaults for all fields
IF '(VALMCNT#9)
DO FLDCTRL^VALM10(VALMCNT)
+37 ; default for 1 field
DO FLDCTRL^VALM10(VALMCNT,"NUMBER")
+38 ;D:'(VALMCNT#5) FLDCTRL^VALM10(VALMCNT,"NAME",IOUON,IOUOFF) ; adhoc
+39 ;adhoc
IF '(VALMCNT#5)
DO FLDCTRL^VALM10(VALMCNT,"DATE/TIME",IOUON,IOUOFF)
+40 IF 'VALMCNT
DO NUL
+41 QUIT
+42 ;
HDR ; -- header
+1 ;N VALMX
+2 ;S VALMX=$G(^DIC(9.4,VALMPKG,0)),X=" Package: "_$P(VALMX,U)
+3 ;S VALMHDR(1)=$$SETSTR^VALM1("Prefix: "_$P(VALMX,U,2),X,63,15)
+4 ;S VALMHDR(2)="Description: "_$E($P(VALMX,U,3),1,65)
+5 NEW MSG
SET MSG="Interface "_$SELECT(INSRCH("TYPE")="ERROR":"Error",1:"Transaction")_" Search"
+6 SET X=""
SET VALMHDR(1)=$$SETSTR^VALM1(MSG,X,26,29)
QUIT
+7 ;
NUL ; -- set nul message
+1 IF 'VALMCNT
Begin DoDot:1
+2 FOR X=" "," No matching records."
SET VALMCNT=VALMCNT+1
DO SET^VALM10(VALMCNT,X)
+3 SET ^TMP("INSRCH",$JOB,1)=1
SET ^(2)=2
End DoDot:1
+4 QUIT
+5 ;
FNL ; -- clean up
+1 KILL DIE,DIC,DR,DA,DE,DQ,VALMY,VALMPKG,^TMP("INSRCH",$JOB)
+2 DO CLEAN^VALM10
+3 QUIT
+4 ;
EXP ; -- expand action
+1 DO FULL^VALM1
+2 NEW VALMI,VALMAT,VALMY
+3 DO EN^VALM2(XQORNOD(0),"O")
SET VALMI=0
+4 FOR
SET VALMI=$ORDER(VALMY(VALMI))
IF 'VALMI
QUIT
Begin DoDot:1
+5 SET VALMAT=$GET(^TMP("INSRCH",$JOB,VALMI))
+6 WRITE !!,@VALMAR@(+VALMAT,0),!
+7 IF INSRCH("TYPE")="TRANSACTION"
SET DIC="^INTHU("
SET DR="0;1;3"
+8 IF INSRCH("TYPE")="ERROR"
SET DIC="^INTHER("
SET DR="0;1;2"
+9 SET DA=+$PIECE(VALMAT,U,2)
DO EN^DIQ
DO PAUSE^VALM1
End DoDot:1
+10 SET VALMBCK="R"
SET VALMSG="'Expand' was last action picked."
+11 QUIT
+12 ;
SEL ; Set selected item into array
+1 ;I $G(INOPT("ARRAY"))'["INREQLST" D EXP S VALMSG="'Select' was last action picked." Q
+2 NEW VALMI,VALMAT,VALMY,INNUM
+3 DO EN^VALM2(XQORNOD(0),"O")
SET VALMI=0
+4 FOR
SET VALMI=$ORDER(VALMY(VALMI))
IF 'VALMI
QUIT
Begin DoDot:1
+5 SET VALMAT=$GET(^TMP("INSRCH",$JOB,VALMI))
+6 WRITE !!,@VALMAR@(+VALMAT,0),!
+7 SET INNUM=+VALMAT
SET DA=+$PIECE(VALMAT,U,2)
+8 ;ARRAY will be set for MTC and REQUEUE functions
+9 IF $GET(INOPT("ARRAY"))["INREQLST"
Begin DoDot:2
+10 ;CHCS listman returns array in DWLMK. GIS expects this
+11 SET DWLMK(INNUM)=""
+12 ;CHCS listman has @DWLRF array that must be populated.
+13 ;It is usually INL
+14 IF '$DATA(DWLRF)
SET DWLRF="INL"
+15 SET @DWLRF@(INNUM)=""
SET @DWLRF@(INNUM,0)=DA
+16 SET VALMSG=$PIECE($GET(^INTHU(DA,0)),U,5)_" selected for processing."
End DoDot:2
QUIT
End DoDot:1
+17 ;
+18 SET VALMBCK="R"
+19 QUIT
+20 ;
UPD(TEXT,FLD,VALMAT) ; -- update data for screen
+1 IF VALMCC
DO FLDCTRL^VALM10(+VALMAT,.FLD,.IOINHI,.IOINORM,1)
+2 DO FLDTEXT^VALM10(+VALMAT,.FLD,.TEXT)
+3 QUIT
+4 ;
+5 ;
