PSIVXREF.m

PSIVXREF ;BIR/CCH-SET MUMPS X REFERENCE ;5/31/90  09:46

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ; this routine is called from the DD to update mumps crossref.

 S NAM=$P(^PS(50.8,DA(2),2,DA(1),2,DA,0),"^",1),FILE=$P(^(0),"^",7),IVDA=$O(^PS(FILE,"B",NAM,0))

 S ^PS(50.8,DA(2),2,DA(1),2,"AC",FILE,IVDA,DA)=""

 S DRGDA=$P(^PS(FILE,NAM,0),"^",2),^PS(50.8,DA(2),2,DA(1),2,"B",NAM,DRGDA,DA)=$P(^PSDRUG(DRGDA,0),"^",9)

 K FILE,NAM,DRGDA,IVDA Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSIVXREF   446     printed  Apr 09, 2024@21:03:30                                                                                                                                                                                                     Page 2

PSIVXREF  ;BIR/CCH-SET MUMPS X REFERENCE ;5/31/90  09:46

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ; this routine is called from the DD to update mumps crossref.

 +3        SET NAM=$PIECE(^PS(50.8,DA(2),2,DA(1),2,DA,0),"^",1)

           SET FILE=$PIECE(^(0),"^",7)

           SET IVDA=$ORDER(^PS(FILE,"B",NAM,0))

 +4        SET ^PS(50.8,DA(2),2,DA(1),2,"AC",FILE,IVDA,DA)=""

 +5        SET DRGDA=$PIECE(^PS(FILE,NAM,0),"^",2)

           SET ^PS(50.8,DA(2),2,DA(1),2,"B",NAM,DRGDA,DA)=$PIECE(^PSDRUG(DRGDA,0),"^",9)

 +6        KILL FILE,NAM,DRGDA,IVDA

           QUIT