- PSIVLTR ;BIR/PR-BUILD LABEL TRACKER FOR ACTIVITY LOG ;03-Aug-2012 14:34;PB
- ;;5.0; INPATIENT MEDICATIONS ;**3,1015**;16 DEC 97;Build 62
- ;This routine needs the following parameters:
- ;TRACK - only defined if label action is dispensed or suspended
- ; 1=Ind lbs, 2=Sched lbs, 3= Sus lbs, 4= Order act lab
- ;ACTION - What is being done with the labels
- ;1=Dispensed, 2=Recycled, 3=Destroyed, 4=Cancelled, 5=Suspended
- ;PSIVNOL- number of labels being acted on
- ;DFN - Patient
- ;ON - Order number
- ;L +^PS(55,DFN,"IV",0)
- ;
- ; Modified - IHS/MSC/PB -04/25/12 - Modified to add the Stability Offset Value to the Label multiple in PS(55
- ;
- S:'$D(^PS(55,DFN,"IV",+ON,"LAB",0)) ^(0)="^55.1111^^" S N=^(0)
- F DA=$P(N,U,3)+1 I '$D(^PS(55,DFN,"IV",+ON,"LAB",DA)) S $P(N,U,3)=DA,$P(N,U,4)=$P(N,U,4)+1,^PS(55,DFN,"IV",+ON,"LAB",0)=N Q
- D NOW^%DTC D @ACTION G K
- ;
- 1 ;Dispensed
- S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK_U_$S('$D(PSIVCT):1,1:0),^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- Q
- ;
- 2 ;Recycled
- S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- Q
- 3 ;Destroyed
- S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- Q
- 4 ;Cancelled
- S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL D ERROR S ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- Q
- 5 ;Suspended
- S J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK,^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- ;IHS/MSC/PB - 4/25/12 Next line added to compute and add the Stablity Offset Value to the Label Multiple in PS(55
- D OFFSET
- Q
- ERROR ;Set piece 8 if user is in the wrong IV room.
- I $D(E)&($D(E1)) S $P(J,U,8)=E1_" "_E
- Q
- K ;
- ;L -^PS(55,DFN,"IV",0) K DA,J,%,N,TRACK,ACTION
- K DA,J,%,N,TRACK,ACTION
- Q
- OFFSET; IHS/MSC/PB - 4/25/12 added to compute the Stability Offset Value and add to the label multiple in PS(55
- ;S:$P(^PS(59.5,+$G(P("IVRM")),9999999),"^")=1 OFFSET=$P(^PS(55,DFN,"IV",+ON,9999999),"^")
- ;IHS/MSC/PB - 08/03/12 modified the line to correct the assumption the node would always exist
- S:$P($G(^PS(59.5,+$G(P("IVRM")),9999999)),"^")=1 OFFSET=$P($G(^PS(55,DFN,"IV",+ON,9999999)),"^")
- D NOW^%DTC S DOFF=$P(%,"."),SOFF=$$FMADD^XLFDT(DOFF,$G(OFFSET),0,0,0),^PS(55,DFN,"IV",+ON,"LAB",DA,9999999)=SOFF
- K SOFF,DOFF,OFFSET
- Q
- PSIVLTR ;BIR/PR-BUILD LABEL TRACKER FOR ACTIVITY LOG ;03-Aug-2012 14:34;PB
- +1 ;;5.0; INPATIENT MEDICATIONS ;**3,1015**;16 DEC 97;Build 62
- +2 ;This routine needs the following parameters:
- +3 ;TRACK - only defined if label action is dispensed or suspended
- +4 ; 1=Ind lbs, 2=Sched lbs, 3= Sus lbs, 4= Order act lab
- +5 ;ACTION - What is being done with the labels
- +6 ;1=Dispensed, 2=Recycled, 3=Destroyed, 4=Cancelled, 5=Suspended
- +7 ;PSIVNOL- number of labels being acted on
- +8 ;DFN - Patient
- +9 ;ON - Order number
- +10 ;L +^PS(55,DFN,"IV",0)
- +11 ;
- +12 ; Modified - IHS/MSC/PB -04/25/12 - Modified to add the Stability Offset Value to the Label multiple in PS(55
- +13 ;
- +14 IF '$DATA(^PS(55,DFN,"IV",+ON,"LAB",0))
- SET ^(0)="^55.1111^^"
- SET N=^(0)
- +15 FOR DA=$PIECE(N,U,3)+1
- IF '$DATA(^PS(55,DFN,"IV",+ON,"LAB",DA))
- SET $PIECE(N,U,3)=DA
- SET $PIECE(N,U,4)=$PIECE(N,U,4)+1
- SET ^PS(55,DFN,"IV",+ON,"LAB",0)=N
- QUIT
- +16 DO NOW^%DTC
- DO @ACTION
- GOTO K
- +17 ;
- 1 ;Dispensed
- +1 SET J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK_U_$SELECT('$DATA(PSIVCT):1,1:0)
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- +2 QUIT
- +3 ;
- 2 ;Recycled
- +1 SET J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL
- DO ERROR
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- +2 QUIT
- 3 ;Destroyed
- +1 SET J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL
- DO ERROR
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- +2 QUIT
- 4 ;Cancelled
- +1 SET J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL
- DO ERROR
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- +2 QUIT
- 5 ;Suspended
- +1 SET J=DA_U_%_U_ACTION_U_DUZ_U_PSIVNOL_U_TRACK
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,0)=J
- +2 ;IHS/MSC/PB - 4/25/12 Next line added to compute and add the Stablity Offset Value to the Label Multiple in PS(55
- +3 DO OFFSET
- +4 QUIT
- ERROR ;Set piece 8 if user is in the wrong IV room.
- +1 IF $DATA(E)&($DATA(E1))
- SET $PIECE(J,U,8)=E1_" "_E
- +2 QUIT
- K ;
- +1 ;L -^PS(55,DFN,"IV",0) K DA,J,%,N,TRACK,ACTION
- +2 KILL DA,J,%,N,TRACK,ACTION
- +3 QUIT
- OFFSET;
- *** ERROR ***
- +1 ;S:$P(^PS(59.5,+$G(P("IVRM")),9999999),"^")=1 OFFSET=$P(^PS(55,DFN,"IV",+ON,9999999),"^")
- +2 ;IHS/MSC/PB - 08/03/12 modified the line to correct the assumption the node would always exist
- +3 IF $PIECE($GET(^PS(59.5,+$GET(P("IVRM")),9999999)),"^")=1
- SET OFFSET=$PIECE($GET(^PS(55,DFN,"IV",+ON,9999999)),"^")
- +4 DO NOW^%DTC
- SET DOFF=$PIECE(%,".")
- SET SOFF=$$FMADD^XLFDT(DOFF,$GET(OFFSET),0,0,0)
- SET ^PS(55,DFN,"IV",+ON,"LAB",DA,9999999)=SOFF
- +5 KILL SOFF,DOFF,OFFSET
- +6 QUIT