APSQDISP ;IHS/ASDS/ENM/POC - LOOK UP
;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
EN1 ;EP
K APSQARR
S APSQCNT=0,APSQLKUP=""
S APSQSEQ=0 F S APSQSEQ=$O(^APSQFAST("S",APSQSEQ)) Q:APSQSEQ="" D
.S APSQLKUP=$$SETSTR^VALM1($J(APSQSEQ,2),APSQLKUP,3,3)
.S APSQIEN=$O(^APSQFAST("S",APSQSEQ,""))
.Q:'APSQIEN
.S APSQNAME=$P(^APSQFAST(APSQIEN,0),U,1)
.S APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,8,15)
.;I $D(^APSQFAST(APSQIEN,2))#10 S APSQSEC="EXPLODE"
.I $O(^APSQFAST(APSQIEN,2,0)) S APSQSEC="EXPLODE"
.E S APSQSEC=$P(^PSDRUG($P(^APSQFAST(APSQIEN,0),U,2),0),U,1)
.S APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,25,20)
.S APSQARR(APSQSEQ,0)=APSQLKUP
.S APSQCNT=APSQCNT+1
.S APSQARR("IDX",APSQCNT,APSQSEQ)=APSQIEN
.S APSQLKUP=""
.Q
;NEED TO SET VALMCNT=APSQCNT
Q
EN2 ;LOOK UP [ 12/06/98 7:08 PM ]
K APSQARR
S (APSQCNT,APSQLKUP)="",(APSQLAST,APSQKILL)=0
S APSQSEQ=0 F S APSQSEQ=$O(^APSQFAST("S",APSQSEQ)) Q:APSQSEQ="" D ;
.D SUB1
.D SWT
.;S:'APSQKILL APSQCNT=APSQCNT+1
.D FILE:'APSQKILL
I APSQKILL S APSQLAST=1 D FILE ;FOR THE LAST ONE IF ODD
;D FILE2
Q
SUB1 ;S APSQSEQ=APSQSEQ+1
I $D(APSQ("GOT",APSQSEQ)) S APSQSTAR=1
I 'APSQKILL S APSQLKUP=$$SETSTR^VALM1($J($S($G(APSQSTAR):"*",1:"")_APSQSEQ,2),APSQLKUP,3,3)
I APSQKILL S APSQLKUP=$$SETSTR^VALM1($J($S($G(APSQSTAR):"*",1:"")_APSQSEQ,2),APSQLKUP,40,3)
K APSQSTAR
S APSQIEN=$O(^APSQFAST("S",APSQSEQ,""))
Q:'APSQIEN
S APSQNAME=$P(^APSQFAST(APSQIEN,0),U,1)
I 'APSQKILL S APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,8,10)
I APSQKILL S APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,45,10)
;I $D(^APSQFAST(APSQIEN,2))#10 S APSQSEC="EXPLODE"
I $O(^APSQFAST(APSQIEN,2,0)) S APSQSEC="EXPLODE"
E S APSQSEC=$P(^PSDRUG($P(^APSQFAST(APSQIEN,0),U,2),0),U,1)
I 'APSQKILL S APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,20,15)
I APSQKILL S APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,57,15)
Q
FILE ;
S APSQCNT=APSQCNT+1
;S APSQARR(APSQSEQ,0)=APSQLKUP
S APSQARR(APSQCNT,0)=APSQLKUP
S APSQLKUP=""
Q
;LINE BELOW FOR LAST ONE
I APSQLAST S APSQLAST=0 S APSQARR("TMP",APSQCNT)=(APSQCNT*2-1)
;THIS WHOLE SERIES OF LINES TO SET IDX IS TO GET AROUND ONE COLUMN
E S APSQARR("TMP",APSQCNT)=(APSQCNT*2-1)_","_(APSQCNT*2)
Q
FILE2 ;FIX IDX
S (I,IDX)=0 F S IDX=$O(APSQARR("TMP",IDX)) Q:IDX="" D
.S I=I+1
.;VALM("BM") IS THE BOTTOM MARGIN MUST BE 6!!! OR MUST CHANGE "4" BELOW
.S APSQBM=VALM("BM")-4 ;GOT FOUR LINES AT BEGINNING OF HEADING
.S APSQARR("IDX",IDX,$S((I=APSQBM)&$P(APSQARR("TMP",IDX),",",2):$P(APSQARR("TMP",IDX),",",2),1:$P(APSQARR("TMP",IDX),",",1)))=""
.I I=VALM("BM") S I=0
;NEED TO SET VALMCNT=APSQCNT
Q
SWT ;SWITH APSQKILL BACK AND FORTH BETWEEN 1 AND 0
;APSQKILL IS USED TO SET THE FIRST AND SECOND PART OF VARIABLE APSQLKUP
;AND SET A APSQARR("DIR",APSQSEQ,APSQIEN)=""
S APSQARR("DIR",APSQSEQ,APSQIEN)=""
I APSQKILL=1 S APSQKILL=0 Q
E S APSQKILL=1
Q
SELECT ;SELECT ENTITIES
;D EN^VALM2(XQORNOD(0),"O") ;this list man call allows user to select an entry in list
;I '$D(VALMY) W !,"Nothing selected." Q
D FULL^VALM1 ;give me full control of screen
Q:'$D(APSQARR("DIR"))
S APSQBEG=$O(APSQARR("DIR","")),APSQEND=$O(APSQARR("DIR",""),-1)
K DIR
S DIR(0)="LO^"_APSQBEG_":"_APSQEND
D ^DIR
I '+Y W !,"NO SELECTIONS-BYE" Q
S APSQY="" F S APSQY=$O(Y(APSQY)) Q:APSQY="" D
.F I=1:1 S APSQGOT=$P(Y(APSQY),",",I) Q:APSQGOT="" D
..S APSQGOTT=$O(APSQARR("DIR",APSQGOT,""))
..I APSQGOTT="" W !,"NO SUCH CRITTER ",APSQGOT," SO ITEM DELETED!"
..;E S APSQARR("GOT",APSQGOTT)=""
..E S APSQARR("GOT",APSQGOT,APSQGOTT)="",APSQ("GOT",APSQGOT,APSQGOTT)=""
D LIST,HANG,EN2,BACK
Q
HANG ;
S DIR(0)="EO",DIR("A")="HIT RETURN TO CONTINUE..." D ^DIR K DIR
Q
LIST ;LIST ENTRIES SELECTED
W !,$S($D(APSQARR("GOT")):"",1:"NO ")," ENTRIES SELECTED:"
S APSQLIST=0 F S APSQLIST=$O(APSQARR("GOT",APSQLIST)) Q:APSQLIST="" D
.S APSQLIS1=$O(APSQARR("GOT",APSQLIST,""))
.W !,$P(^APSQFAST(APSQLIS1,0),U,1)
Q
BACK ;GO BACK
D TERM^VALM0
S VALMBCK="R"
;D INIT AGAIN
K DIR
Q
APSQDISP ;IHS/ASDS/ENM/POC - LOOK UP
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
EN1 ;EP
+1 KILL APSQARR
+2 SET APSQCNT=0
SET APSQLKUP=""
+3 SET APSQSEQ=0
FOR
SET APSQSEQ=$ORDER(^APSQFAST("S",APSQSEQ))
IF APSQSEQ=""
QUIT
Begin DoDot:1
+4 SET APSQLKUP=$$SETSTR^VALM1($JUSTIFY(APSQSEQ,2),APSQLKUP,3,3)
+5 SET APSQIEN=$ORDER(^APSQFAST("S",APSQSEQ,""))
+6 IF 'APSQIEN
QUIT
+7 SET APSQNAME=$PIECE(^APSQFAST(APSQIEN,0),U,1)
+8 SET APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,8,15)
+9 ;I $D(^APSQFAST(APSQIEN,2))#10 S APSQSEC="EXPLODE"
+10 IF $ORDER(^APSQFAST(APSQIEN,2,0))
SET APSQSEC="EXPLODE"
+11 IF '$TEST
SET APSQSEC=$PIECE(^PSDRUG($PIECE(^APSQFAST(APSQIEN,0),U,2),0),U,1)
+12 SET APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,25,20)
+13 SET APSQARR(APSQSEQ,0)=APSQLKUP
+14 SET APSQCNT=APSQCNT+1
+15 SET APSQARR("IDX",APSQCNT,APSQSEQ)=APSQIEN
+16 SET APSQLKUP=""
+17 QUIT
End DoDot:1
+18 ;NEED TO SET VALMCNT=APSQCNT
+19 QUIT
EN2 ;LOOK UP [ 12/06/98 7:08 PM ]
+1 KILL APSQARR
+2 SET (APSQCNT,APSQLKUP)=""
SET (APSQLAST,APSQKILL)=0
+3 ;
SET APSQSEQ=0
FOR
SET APSQSEQ=$ORDER(^APSQFAST("S",APSQSEQ))
IF APSQSEQ=""
QUIT
Begin DoDot:1
+4 DO SUB1
+5 DO SWT
+6 ;S:'APSQKILL APSQCNT=APSQCNT+1
+7 IF 'APSQKILL
DO FILE
End DoDot:1
+8 ;FOR THE LAST ONE IF ODD
IF APSQKILL
SET APSQLAST=1
DO FILE
+9 ;D FILE2
+10 QUIT
SUB1 ;S APSQSEQ=APSQSEQ+1
+1 IF $DATA(APSQ("GOT",APSQSEQ))
SET APSQSTAR=1
+2 IF 'APSQKILL
SET APSQLKUP=$$SETSTR^VALM1($JUSTIFY($SELECT($GET(APSQSTAR):"*",1:"")_APSQSEQ,2),APSQLKUP,3,3)
+3 IF APSQKILL
SET APSQLKUP=$$SETSTR^VALM1($JUSTIFY($SELECT($GET(APSQSTAR):"*",1:"")_APSQSEQ,2),APSQLKUP,40,3)
+4 KILL APSQSTAR
+5 SET APSQIEN=$ORDER(^APSQFAST("S",APSQSEQ,""))
+6 IF 'APSQIEN
QUIT
+7 SET APSQNAME=$PIECE(^APSQFAST(APSQIEN,0),U,1)
+8 IF 'APSQKILL
SET APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,8,10)
+9 IF APSQKILL
SET APSQLKUP=$$SETSTR^VALM1(APSQNAME,APSQLKUP,45,10)
+10 ;I $D(^APSQFAST(APSQIEN,2))#10 S APSQSEC="EXPLODE"
+11 IF $ORDER(^APSQFAST(APSQIEN,2,0))
SET APSQSEC="EXPLODE"
+12 IF '$TEST
SET APSQSEC=$PIECE(^PSDRUG($PIECE(^APSQFAST(APSQIEN,0),U,2),0),U,1)
+13 IF 'APSQKILL
SET APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,20,15)
+14 IF APSQKILL
SET APSQLKUP=$$SETSTR^VALM1(APSQSEC,APSQLKUP,57,15)
+15 QUIT
FILE ;
+1 SET APSQCNT=APSQCNT+1
+2 ;S APSQARR(APSQSEQ,0)=APSQLKUP
+3 SET APSQARR(APSQCNT,0)=APSQLKUP
+4 SET APSQLKUP=""
+5 QUIT
+6 ;LINE BELOW FOR LAST ONE
+7 IF APSQLAST
SET APSQLAST=0
SET APSQARR("TMP",APSQCNT)=(APSQCNT*2-1)
+8 ;THIS WHOLE SERIES OF LINES TO SET IDX IS TO GET AROUND ONE COLUMN
+9 IF '$TEST
SET APSQARR("TMP",APSQCNT)=(APSQCNT*2-1)_","_(APSQCNT*2)
+10 QUIT
FILE2 ;FIX IDX
+1 SET (I,IDX)=0
FOR
SET IDX=$ORDER(APSQARR("TMP",IDX))
IF IDX=""
QUIT
Begin DoDot:1
+2 SET I=I+1
+3 ;VALM("BM") IS THE BOTTOM MARGIN MUST BE 6!!! OR MUST CHANGE "4" BELOW
+4 ;GOT FOUR LINES AT BEGINNING OF HEADING
SET APSQBM=VALM("BM")-4
+5 SET APSQARR("IDX",IDX,$SELECT((I=APSQBM)&$PIECE(APSQARR("TMP",IDX),",",2):$PIECE(APSQARR("TMP",IDX),",",2),1:$PIECE(APSQARR("TMP",IDX),",",1)))=""
+6 IF I=VALM("BM")
SET I=0
End DoDot:1
+7 ;NEED TO SET VALMCNT=APSQCNT
+8 QUIT
SWT ;SWITH APSQKILL BACK AND FORTH BETWEEN 1 AND 0
+1 ;APSQKILL IS USED TO SET THE FIRST AND SECOND PART OF VARIABLE APSQLKUP
+2 ;AND SET A APSQARR("DIR",APSQSEQ,APSQIEN)=""
+3 SET APSQARR("DIR",APSQSEQ,APSQIEN)=""
+4 IF APSQKILL=1
SET APSQKILL=0
QUIT
+5 IF '$TEST
SET APSQKILL=1
+6 QUIT
SELECT ;SELECT ENTITIES
+1 ;D EN^VALM2(XQORNOD(0),"O") ;this list man call allows user to select an entry in list
+2 ;I '$D(VALMY) W !,"Nothing selected." Q
+3 ;give me full control of screen
DO FULL^VALM1
+4 IF '$DATA(APSQARR("DIR"))
QUIT
+5 SET APSQBEG=$ORDER(APSQARR("DIR",""))
SET APSQEND=$ORDER(APSQARR("DIR",""),-1)
+6 KILL DIR
+7 SET DIR(0)="LO^"_APSQBEG_":"_APSQEND
+8 DO ^DIR
+9 IF '+Y
WRITE !,"NO SELECTIONS-BYE"
QUIT
+10 SET APSQY=""
FOR
SET APSQY=$ORDER(Y(APSQY))
IF APSQY=""
QUIT
Begin DoDot:1
+11 FOR I=1:1
SET APSQGOT=$PIECE(Y(APSQY),",",I)
IF APSQGOT=""
QUIT
Begin DoDot:2
+12 SET APSQGOTT=$ORDER(APSQARR("DIR",APSQGOT,""))
+13 IF APSQGOTT=""
WRITE !,"NO SUCH CRITTER ",APSQGOT," SO ITEM DELETED!"
+14 ;E S APSQARR("GOT",APSQGOTT)=""
+15 IF '$TEST
SET APSQARR("GOT",APSQGOT,APSQGOTT)=""
SET APSQ("GOT",APSQGOT,APSQGOTT)=""
End DoDot:2
End DoDot:1
+16 DO LIST
DO HANG
DO EN2
DO BACK
+17 QUIT
HANG ;
+1 SET DIR(0)="EO"
SET DIR("A")="HIT RETURN TO CONTINUE..."
DO ^DIR
KILL DIR
+2 QUIT
LIST ;LIST ENTRIES SELECTED
+1 WRITE !,$SELECT($DATA(APSQARR("GOT")):"",1:"NO ")," ENTRIES SELECTED:"
+2 SET APSQLIST=0
FOR
SET APSQLIST=$ORDER(APSQARR("GOT",APSQLIST))
IF APSQLIST=""
QUIT
Begin DoDot:1
+3 SET APSQLIS1=$ORDER(APSQARR("GOT",APSQLIST,""))
+4 WRITE !,$PIECE(^APSQFAST(APSQLIS1,0),U,1)
End DoDot:1
+5 QUIT
BACK ;GO BACK
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 ;D INIT AGAIN
+4 KILL DIR
+5 QUIT
