Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRVORE3

GMRVORE3.m

Go to the documentation of this file.
GMRVORE3 ;HIRMFO/MD,RM-ENTRY TO STORE DATA FOR BOTH GMR ORDER RECORDS ;4/15/96
 ;;4.0;Vitals/Measurements;;Apr 25, 1997
UNREL ; ENTRY TO STORE DATA FOR BOTH GMR ORDER RECORDS
 I ORACTION=0!(ORACTION=1&GMRVNEW) D
 .S ORPCL=$S('ORACTION:XQORNOD,1:$P(GMRVORD(1),U,5)),ORTX=">> "_$S('ORACTION:$P($G(^ORD(101,+XQORNOD,0)),"^",2),1:$P($P(GMRVORD(2),U,5)," - "))_" - "_$P(GMRVAS,U)_" - "_$S(GMRVCOM]"":GMRVCOM,1:"(No Special Instructions)")
 .Q
 I  S ORSTS=11,ORSTRT=GMRVSTRT,ORSTOP=GMRVSTOP,ORPK=GMRVSTRT_U_GMRVSTOP_U_GMRVAS_U_GMRVCOM_U_$S(ORACTION=1:ORIFN,1:$P(GMRVORD(3),U,7)) D FILE^ORX
 I ORACTION=1,'GMRVNEW S ORETURN("ORSTOP")=GMRVSTOP,ORETURN("ORSTRT")=GMRVSTRT,ORETURN("ORPK")=GMRVSTRT_U_GMRVSTOP_U_GMRVAS_U_GMRVCOM_U_$P(GMRVORD(3),U,7),ORETURN("ORTX")=$G(ORTX) D RETURN^ORX
 I ORACTION=2 S GMRVOIFN=ORIFN,ORPCL=$P(GMRVORD(1),U,5),ORTO=$P(GMRVORD(1),U,11),ORIT=$P(GMRVORD(2),U,4),ORL=$P(GMRVORD(1),U,10),ORPK=GMRVSTRT_U_GMRVSTOP_U_GMRVAS_U_GMRVCOM_U_ORIFN
 I  S ORTX=$P(GMRVORD(2),U,5),ORSTS=11,ORSTRT=GMRVSTRT,ORSTOP=GMRVSTOP D FILE^ORX S ORIFN=GMRVOIFN
 Q
REL ;
 S:GMRVSTOP?1"~".E GMRVSTOP=$E(GMRVSTOP,2,99) S:GMRVSTRT?1"~".E GMRVSTRT=$E(GMRVSTRT,2,99) S:GMRVAS?1"~".E GMRVAS=$E(GMRVAS,2,99) S:GMRVCOM?1"~" GMRVCOM=$E(GMRVCOM,2,99)
 S GMRVOIFN=ORIFN I $P(GMRVORD(3),U,7)>0 D NOW^%DTC S ORIFN=$P(GMRVORD(3),U,7),ORETURN("ORSTOP")=%,ORETURN("ORSTS")=1 D RETURN^ORX
 S ORIFN=GMRVOIFN D NOW^%DTC S ORETURN("ORSTS")=$S(GMRVSTRT'>%:6,1:8),ORETURN("OREVENT")=$S(ORETURN("ORSTS")=6:GMRVSTOP_";C",1:GMRVSTRT_";A"),ORETURN("ORPK")="" D RETURN^ORX
 S ORIFN=GMRVOIFN S:'$D(^GMR(120.55,ORIFN,0)) $P(^GMR(120.55,0),"^",3,4)=ORIFN_"^"_($P(^GMR(120.55,0),"^",4)+1) S DA=ORIFN,^GMR(120.55,ORIFN,0)=ORIFN_"^"_GMRVAS,DIK="^GMR(120.55," D IX1^DIK S:GMRVCOM'="" ^GMR(120.55,ORIFN,"O")=GMRVCOM
 Q