- 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
