ACRFESS ;IHS/OIRM/DSD/THL,AEF - EDIT SUPPLY/SERVICE ITEM; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO ALLOW EDIT OF SUPPLY/SERVICE ITEMS
EN D GATHER
D DDS^ACRFDIC
I '$D(ACRSCREN) D S ACRQUIT="" K ACROBJC Q
.S ACROBJC=$P(ACRSS0,U,4)
.Q:'ACROBJC
.S ACROBJC=$P($G(^AUTTOBJC(ACROBJC,0)),U)
.Q:$E(ACROBJC,1,2)'=31
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR="[ACR CAPITALIZED EQUIPMENT]"
.D DDS^ACRFDIC
.Q:$P($G(^ACRSS(ACRSSDA,"DT")),U,15)<3
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR="[ACR REPLACEMENT EQUIPMENT]"
.D DDS^ACRFDIC
I $G(ACRTXDA)=35,$D(ACRSCREN) D S ACRQUIT="" Q
.S DIE="^ACRSS("
.S DR="[ACR CREDIT CARD ITEM]"
.D DIE^ACRFDIC
K ACRSCREN
I $D(ACRNEWSS) D DIE^ACRFDIC K ACRNEWSS
N ACRX,ACRSS0,ACRSS1,ACRSSDT,ACRFLDS,ACRY,ACR,ACRSSDSC,ACRJ,ACRJJ
D FIELDS
F D EN1 Q:$D(ACRQUIT)
EXIT K ACROBJC,ACRSSSPC
Q
EN1 ;
D DISP
S DIR(0)="LO^1:7"
S DIR("A")=" Edit which fields"
D DIR^ACRFDIC
I +Y<1 S ACRQUIT="" Q
S ACRFLDS=ACRY
W !
F ACRJJ=1:1 S ACRX=$P(ACRFLDS,",",ACRJJ) Q:ACRX="" D DIE
Q
DIE S DA=ACRSSDA
S DIE="^ACRSS("
S DR=ACR("DR",ACRX)
I $E(DR)'="[",DR'["T" S DR=DR_"T"
D DIE^ACRFDIC
Q
DISP ;DISPLAY ITEM INFO
D GATHER
W @IOF
W !?18,@ACRON,"SUPPLY/SERVICE ITEM INFORMATION",@ACROF
W !!,"1. QUANTITY REQ'D: ",$G(ACR(1))
W ?40,"4. NATL STOCK NO.: ",$G(ACR(4))
W !,"2. UNIT OF ISSUE.: ",$G(ACR(2))
W ?40,"5. NATL DRUG CODE: ",$G(ACR(5))
W !,"3. UNIT COST.....: ",$G(ACR(3))
W ?40,"6. VENDOR PART NO: ",$G(ACR(6))
W !!,"7. DESCRIPTION:"
F X=7,8 S ACRX=$G(ACR(X)) D:ACRX]"" D1
W !,"--------------------------------------------------------------------------------"
Q
D1 S ACRX=$TR(ACRX,"^"," ")
W !?3
F ACRJ=1:1 S X=$P(ACRX," ",ACRJ) Q:$P(ACRX," ",ACRJ,99)="" W:$X+$L(X)>78 !?3 W X," "
Q
GATHER ;GATHER ITEM INFO
S ACRSS0=$G(^ACRSS(ACRSSDA,0))
S ACRSSDT=$G(^ACRSS(ACRSSDA,"DT"))
S ACRSSDSC=$G(^ACRSS(ACRSSDA,"DESC"))
S ACRSSNMS=$G(^ACRSS(ACRSSDA,"NMS"))
S ACRSSSPC=$G(^ACRSS(ACRSSDA,"NOTES"))
S ACR(1)=$P(ACRSSDT,U)
S X=$P(ACRSSDT,U,2)
S ACR(2)=$P($G(^ACRUI(+X,0)),U)
S ACR(3)=$P(ACRSSDT,U,3)
S ACR(4)=$P(ACRSSNMS,U,2)
S ACR(5)=$P(ACRSSNMS,U,3)
S ACR(6)=$P(ACRSSNMS,U)
S ACR(7)=ACRSSDSC
S ACR(8)=ACRSSSPC
Q
FIELDS ;SET FIELDS TO BE EDITED
S ACR("DR",1)="10T"
S ACR("DR",2)="11T"
S ACR("DR",3)="12T"
S ACR("DR",4)="2T"
S ACR("DR",5)="3T"
S ACR("DR",6)="1T"
S ACR("DR",7)="[ACR DESCRIPTION]"
Q
ACRFESS ;IHS/OIRM/DSD/THL,AEF - EDIT SUPPLY/SERVICE ITEM; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO ALLOW EDIT OF SUPPLY/SERVICE ITEMS
EN DO GATHER
+1 DO DDS^ACRFDIC
+2 IF '$DATA(ACRSCREN)
Begin DoDot:1
+3 SET ACROBJC=$PIECE(ACRSS0,U,4)
+4 IF 'ACROBJC
QUIT
+5 SET ACROBJC=$PIECE($GET(^AUTTOBJC(ACROBJC,0)),U)
+6 IF $EXTRACT(ACROBJC,1,2)'=31
QUIT
+7 SET DA=ACRSSDA
+8 SET DIE="^ACRSS("
+9 SET DR="[ACR CAPITALIZED EQUIPMENT]"
+10 DO DDS^ACRFDIC
+11 IF $PIECE($GET(^ACRSS(ACRSSDA,"DT")),U,15)<3
QUIT
+12 SET DA=ACRSSDA
+13 SET DIE="^ACRSS("
+14 SET DR="[ACR REPLACEMENT EQUIPMENT]"
+15 DO DDS^ACRFDIC
End DoDot:1
SET ACRQUIT=""
KILL ACROBJC
QUIT
+16 IF $GET(ACRTXDA)=35
IF $DATA(ACRSCREN)
Begin DoDot:1
+17 SET DIE="^ACRSS("
+18 SET DR="[ACR CREDIT CARD ITEM]"
+19 DO DIE^ACRFDIC
End DoDot:1
SET ACRQUIT=""
QUIT
+20 KILL ACRSCREN
+21 IF $DATA(ACRNEWSS)
DO DIE^ACRFDIC
KILL ACRNEWSS
+22 NEW ACRX,ACRSS0,ACRSS1,ACRSSDT,ACRFLDS,ACRY,ACR,ACRSSDSC,ACRJ,ACRJJ
+23 DO FIELDS
+24 FOR
DO EN1
IF $DATA(ACRQUIT)
QUIT
EXIT KILL ACROBJC,ACRSSSPC
+1 QUIT
EN1 ;
+1 DO DISP
+2 SET DIR(0)="LO^1:7"
+3 SET DIR("A")=" Edit which fields"
+4 DO DIR^ACRFDIC
+5 IF +Y<1
SET ACRQUIT=""
QUIT
+6 SET ACRFLDS=ACRY
+7 WRITE !
+8 FOR ACRJJ=1:1
SET ACRX=$PIECE(ACRFLDS,",",ACRJJ)
IF ACRX=""
QUIT
DO DIE
+9 QUIT
DIE SET DA=ACRSSDA
+1 SET DIE="^ACRSS("
+2 SET DR=ACR("DR",ACRX)
+3 IF $EXTRACT(DR)'="["
IF DR'["T"
SET DR=DR_"T"
+4 DO DIE^ACRFDIC
+5 QUIT
DISP ;DISPLAY ITEM INFO
+1 DO GATHER
+2 WRITE @IOF
+3 WRITE !?18,@ACRON,"SUPPLY/SERVICE ITEM INFORMATION",@ACROF
+4 WRITE !!,"1. QUANTITY REQ'D: ",$GET(ACR(1))
+5 WRITE ?40,"4. NATL STOCK NO.: ",$GET(ACR(4))
+6 WRITE !,"2. UNIT OF ISSUE.: ",$GET(ACR(2))
+7 WRITE ?40,"5. NATL DRUG CODE: ",$GET(ACR(5))
+8 WRITE !,"3. UNIT COST.....: ",$GET(ACR(3))
+9 WRITE ?40,"6. VENDOR PART NO: ",$GET(ACR(6))
+10 WRITE !!,"7. DESCRIPTION:"
+11 FOR X=7,8
SET ACRX=$GET(ACR(X))
IF ACRX]""
DO D1
+12 WRITE !,"--------------------------------------------------------------------------------"
+13 QUIT
D1 SET ACRX=$TRANSLATE(ACRX,"^"," ")
+1 WRITE !?3
+2 FOR ACRJ=1:1
SET X=$PIECE(ACRX," ",ACRJ)
IF $PIECE(ACRX," ",ACRJ,99)=""
QUIT
IF $X+$LENGTH(X)>78
WRITE !?3
WRITE X," "
+3 QUIT
GATHER ;GATHER ITEM INFO
+1 SET ACRSS0=$GET(^ACRSS(ACRSSDA,0))
+2 SET ACRSSDT=$GET(^ACRSS(ACRSSDA,"DT"))
+3 SET ACRSSDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+4 SET ACRSSNMS=$GET(^ACRSS(ACRSSDA,"NMS"))
+5 SET ACRSSSPC=$GET(^ACRSS(ACRSSDA,"NOTES"))
+6 SET ACR(1)=$PIECE(ACRSSDT,U)
+7 SET X=$PIECE(ACRSSDT,U,2)
+8 SET ACR(2)=$PIECE($GET(^ACRUI(+X,0)),U)
+9 SET ACR(3)=$PIECE(ACRSSDT,U,3)
+10 SET ACR(4)=$PIECE(ACRSSNMS,U,2)
+11 SET ACR(5)=$PIECE(ACRSSNMS,U,3)
+12 SET ACR(6)=$PIECE(ACRSSNMS,U)
+13 SET ACR(7)=ACRSSDSC
+14 SET ACR(8)=ACRSSSPC
+15 QUIT
FIELDS ;SET FIELDS TO BE EDITED
+1 SET ACR("DR",1)="10T"
+2 SET ACR("DR",2)="11T"
+3 SET ACR("DR",3)="12T"
+4 SET ACR("DR",4)="2T"
+5 SET ACR("DR",5)="3T"
+6 SET ACR("DR",6)="1T"
+7 SET ACR("DR",7)="[ACR DESCRIPTION]"
+8 QUIT
