PSGVDS ;BIR/CML3-VARIOUS DATA SETS ;16 DEC 97 / 1:38 PM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
ENL ; Adds entries to 53.41 for NV UD, V UD, and IV orders.
S ^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,1,DA,0)=DA_"^"_$S($D(PSJSYSW):PSJSYSW,1:"")_"^"_PSGDT
I $D(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,1,0))#2 S $P(^(0),"^",3,4)=DA_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="^53.4104A^"_DA_"^1" Q:$D(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,0)) S ^(0)=PSGTOO ; naked refers to line above it
I $D(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,0))#2 S $P(^(0),"^",3,4)=PSGTOO_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="^53.4103SA^"_PSGTOO_"^1" Q:$D(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,0)) S ^(0)=PSGP ; naked refers to line above it
I $D(^PS(53.41,PSGTOL,1,PSGUOW,1,0))#2 S $P(^(0),"^",3,4)=PSGP_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="^53.4102PA^"_PSGP_"^1" Q:$D(^PS(53.41,PSGTOL,1,PSGUOW,0)) S ^(0)=PSGUOW ; naked refers to line above it
I $D(^PS(53.41,PSGTOL,1,0))#2 S $P(^(0),"^",3,4)=PSGUOW_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="^53.4101A^"_PSGUOW_"^1" Q:$D(^PS(53.41,PSGTOL,0)) S ^(0)=PSGTOL ; naked refers to line above it
I $D(^PS(53.41,0))#2 S $P(^(0),"^",3,4)=PSGTOL_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="MAR LABELS^53.41S^"_PSGTOL_"^2" Q ; naked refers to line above it
;
ENPOS ; provider order set
F Y=1:1 I '$D(^PS(53.44,DUZ,1,PSGP,1,Y)) Q
S ^PS(53.44,DUZ,1,PSGP,1,Y,0)=PSGORD_"^"_PSGPOSA_"^"_PSGPOSD,^PS(53.44,DUZ,1,PSGP,1,"AA",PSGPOSA,Y)="",^PS(53.44,DUZ,1,PSGP,1,"AD",+PSGPOSD,Y)="",^PS(53.44,DUZ,1,PSGP,1,"B",PSGORD,Y)=""
I $D(^PS(53.44,DUZ,1,PSGP,1,0))#2 S $P(^(0),"^",3,4)=Y_"^"_($P(^(0),"^",4)+1) Q
S ^(0)="^53.4402P^"_Y_"^1" Q:$D(^PS(53.44,DUZ,1,PSGP,0)) S ^(0)=PSGP I $D(^PS(53.44,DUZ,1,0))#2 S $P(^(0),"^",3,4)=PSGP_"^"_($P(^(0),"^",4)+1) Q ; naked refers to line above it
S ^(0)="^53.4401P^"_PSGP_"^1" I $D(^PS(53.44,DUZ,0))#2 S $P(^(0),"^",3,4)=DUZ_"^"_($P(^(0),"^",4)+1) Q ; naked refers to line above it
S ^(0)=DUZ I $D(^PS(53.44,0))#2 S $P(^(0),"^",3,4)=DUZ_"^"_($P(^(0),"^",4)+1) Q ; naked refers to line above it
S ^(0)="PROVIDER'S ORDERS^53.44P^"_DUZ_"^1" Q ; naked refers to line above it
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVDS 2127 printed Oct 16, 2024@18:04:15 Page 2
PSGVDS ;BIR/CML3-VARIOUS DATA SETS ;16 DEC 97 / 1:38 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
ENL ; Adds entries to 53.41 for NV UD, V UD, and IV orders.
+1 SET ^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,1,DA,0)=DA_"^"_$SELECT($DATA(PSJSYSW):PSJSYSW,1:"")_"^"_PSGDT
+2 IF $DATA(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,1,0))#2
SET $PIECE(^(0),"^",3,4)=DA_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+3 ; naked refers to line above it
SET ^(0)="^53.4104A^"_DA_"^1"
if $DATA(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,PSGTOO,0))
QUIT
SET ^(0)=PSGTOO
+4 IF $DATA(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,1,0))#2
SET $PIECE(^(0),"^",3,4)=PSGTOO_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+5 ; naked refers to line above it
SET ^(0)="^53.4103SA^"_PSGTOO_"^1"
if $DATA(^PS(53.41,PSGTOL,1,PSGUOW,1,PSGP,0))
QUIT
SET ^(0)=PSGP
+6 IF $DATA(^PS(53.41,PSGTOL,1,PSGUOW,1,0))#2
SET $PIECE(^(0),"^",3,4)=PSGP_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+7 ; naked refers to line above it
SET ^(0)="^53.4102PA^"_PSGP_"^1"
if $DATA(^PS(53.41,PSGTOL,1,PSGUOW,0))
QUIT
SET ^(0)=PSGUOW
+8 IF $DATA(^PS(53.41,PSGTOL,1,0))#2
SET $PIECE(^(0),"^",3,4)=PSGUOW_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+9 ; naked refers to line above it
SET ^(0)="^53.4101A^"_PSGUOW_"^1"
if $DATA(^PS(53.41,PSGTOL,0))
QUIT
SET ^(0)=PSGTOL
+10 IF $DATA(^PS(53.41,0))#2
SET $PIECE(^(0),"^",3,4)=PSGTOL_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+11 ; naked refers to line above it
SET ^(0)="MAR LABELS^53.41S^"_PSGTOL_"^2"
QUIT
+12 ;
ENPOS ; provider order set
+1 FOR Y=1:1
IF '$DATA(^PS(53.44,DUZ,1,PSGP,1,Y))
QUIT
+2 SET ^PS(53.44,DUZ,1,PSGP,1,Y,0)=PSGORD_"^"_PSGPOSA_"^"_PSGPOSD
SET ^PS(53.44,DUZ,1,PSGP,1,"AA",PSGPOSA,Y)=""
SET ^PS(53.44,DUZ,1,PSGP,1,"AD",+PSGPOSD,Y)=""
SET ^PS(53.44,DUZ,1,PSGP,1,"B",PSGORD,Y)=""
+3 IF $DATA(^PS(53.44,DUZ,1,PSGP,1,0))#2
SET $PIECE(^(0),"^",3,4)=Y_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+4 ; naked refers to line above it
SET ^(0)="^53.4402P^"_Y_"^1"
if $DATA(^PS(53.44,DUZ,1,PSGP,0))
QUIT
SET ^(0)=PSGP
IF $DATA(^PS(53.44,DUZ,1,0))#2
SET $PIECE(^(0),"^",3,4)=PSGP_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+5 ; naked refers to line above it
SET ^(0)="^53.4401P^"_PSGP_"^1"
IF $DATA(^PS(53.44,DUZ,0))#2
SET $PIECE(^(0),"^",3,4)=DUZ_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+6 ; naked refers to line above it
SET ^(0)=DUZ
IF $DATA(^PS(53.44,0))#2
SET $PIECE(^(0),"^",3,4)=DUZ_"^"_($PIECE(^(0),"^",4)+1)
QUIT
+7 ; naked refers to line above it
SET ^(0)="PROVIDER'S ORDERS^53.44P^"_DUZ_"^1"
QUIT
