- 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 ;