Index: /PGC/tags/PHP-PGC/GMRVED2.m
===================================================================
--- /PGC/tags/PHP-PGC/GMRVED2.m (revision 1504)
+++ /PGC/tags/PHP-PGC/GMRVED2.m (revision 1504)
@@ -0,0 +1,142 @@
+GMRVED2 ;HIOFO/RM,YH,FT-VITAL SIGNS EDIT SHORT FORM ;7/20/07 13:43
+ ;;5.0;GEN. MED. REC. - VITALS;**2**;Oct 31, 2002;Build 15
+ ;
+ ; This routine uses the following IAs:
+ ; #10035 - ^DPT( references (supported)
+ ; #10061 - ^VADPT calls (supported)
+ ; #10103 - ^XLFDT calls (supported)
+ ; #10104 - ^XLFSTR calls (supported)
+ ;
+EN1 ; SORT PATIENTS ON WARD
+ K ^TMP($J)
+WSA1 ; SET ^TMP($J, FOR SORT
+ D DEM^VADPT,INP^VADPT S GMRRMBD=$S(VAIN(5)'="":VAIN(5),1:" BLANK"),GMRNAM=$S(VADM(1)'="":VADM(1),1:" BLANK") D KVAR^VADPT K VA
+ S:$S("Aa"[GMREDB:1,$D(GMRROOM($P(GMRRMBD,"-"))):1,1:0) ^TMP($J,GMRRMBD,GMRNAM,DFN)=""
+ S DFN=$O(^DPT("CN",GMRWARD(1),DFN))
+ Q:DFN="" G WSA1
+EN2 ; BEGIN EDITING WARD VITALS
+ I $O(^TMP($J,0))="" S GMROUT=1 Q
+ W !,"Begin entering patient vitals." S GMRDT0=GMRVIDT
+ S GMRRMBD="" F GMRI=0:0 S GMRRMBD=$O(^TMP($J,GMRRMBD)) Q:GMRRMBD=""!GMROUT S GMRNAM="" F GMRI=0:0 S GMRNAM=$O(^TMP($J,GMRRMBD,GMRNAM)) Q:GMRNAM=""!GMROUT F DFN=0:0 S DFN=$O(^TMP($J,GMRRMBD,GMRNAM,DFN)) Q:DFN'>0 D V1 Q:GMROUT
+ W !,"Enter return to continue" R X:DTIME Q
+V1 ;
+ W !!,$S(GMRNAM'=" BLANK":GMRNAM,1:DFN),?$X+10,$S(GMRRMBD'=" BLANK":GMRRMBD,1:"")," OK? YES// " R GMRX:DTIME
+ I GMRX="^"!('$T) S GMROUT=1 Q
+ S GMRX=$$UP^XLFSTR(GMRX) I ((GMRX="")!($E(GMRX)="Y")) K GMRTO S GDT=GMRVIDT D EN1^GMRVADM G:GMROUT&'$D(GMRTO) V2 D EN2^GMRVED3 G:GMROUT&'$D(GMRTO) V2 Q
+ G:GMRX?1"N".E V2
+ W !,"ANSWER YES OR NO" G V1
+V2 ;
+ W !!,"Do you wish to stop looping through names? YES//" R GMRX:DTIME
+ S GMRX=$$UP^XLFSTR(GMRX) I (('$T)!(GMRX="")!($E(GMRX)="Y")!(GMRX="^")) S GMROUT=1 Q
+ I GMRX?1"N".E S GMROUT=0 Q
+ W !,"ANSWER YES OR NO" G V2
+EN4 ; ENTRY FROM GMRVED0 TO ADD THE PATIENT DATA TO THE 120.5 FILE
+ D NOW^%DTC S GMRDATE=%
+ F GMRX=2:1:$L(GMRSTR(0),";")-1 S GMRVITY=$P(GMRSTR(0),";",GMRX) D
+ . S GMRVIT=$S(GMRVITY="T":"TEMPERATURE",GMRVITY="P":"PULSE",GMRVITY="R":"RESPIRATION",GMRVITY="BP":"BLOOD PRESSURE",GMRVITY="HT":"HEIGHT",GMRVITY="CG":"CIRCUMFERENCE/GIRTH",1:"")
+ . S:GMRVIT="" GMRVIT=$S(GMRVITY="WT":"WEIGHT",GMRVITY="CVP":"CENTRAL VENOUS PRESSURE",GMRVITY="PO2":"PULSE OXIMETRY",GMRVITY="PN":"PAIN",1:"")
+ . D:$G(GMRDAT(GMRVITY))'=""&(GMRVIT'="") ADDNODE
+ Q
+ADDNODE ; add data to the 120.5 file
+ N GMVDTDUN,GMVFDA,GMVIEN
+ S GMVDTDUN=GMRVIDT
+ S GMRVIT(1)=$O(^GMRD(120.51,"B",GMRVIT,0))
+ S GMVDTDUN=$$CHKDT(GMRVIDT,GMRVIT(1))
+ S GMVFDA(120.5,"+1,",.01)=GMVDTDUN ;Date/Time
+ S GMVFDA(120.5,"+1,",.02)=DFN ;Patient
+ S GMVFDA(120.5,"+1,",.03)=GMRVIT(1) ;Vital Type
+ S GMVFDA(120.5,"+1,",.04)=GMRDATE ;Date Time entered
+ S GMVFDA(120.5,"+1,",.05)=GMRVHLOC ;Hospital
+ S GMVFDA(120.5,"+1,",.06)=DUZ ;Entered by (DUZ)
+ S GMVFDA(120.5,"+1,",1.2)=GMRDAT(GMRVITY) ;Rate
+ S GMVFDA(120.5,"+1,",1.4)=$G(GMRO2(GMRVITY)) ;Sup 02
+ S GMVIEN=""
+ D UPDATE^DIE("","GMVFDA","GMVIEN")
+ ;file any qualifiers
+ I $D(GMRSITE(GMRVITY))!$D(GMRINF(GMRVITY)) D
+ .I $G(GMRSITE(GMRVITY))'="" D
+ ..S GDATA=+$P(GMRSITE(GMRVITY),U,2)
+ ..Q:'GDATA
+ ..D ADDQUAL(GMVIEN(1)_"^"_GDATA)
+ ..Q
+ .I $D(GMRINF(GMRVITY)) D
+ ..S I=0
+ ..F S I=$O(GMRINF(GMRVITY,I)) Q:I'>0 D
+ ...S I(1)=""
+ ...F S I(1)=$O(GMRINF(GMRVITY,I,I(1))) Q:I(1)="" D
+ ....S GDATA=+$P(GMRINF(GMRVITY,I,I(1)),"^")
+ ....Q:'GDATA
+ ....D ADDQUAL(GMVIEN(1)_"^"_GDATA)
+ ....Q
+ ...Q
+ ..Q
+ .Q
+ S DA=+GMVIEN(1)
+ I GMREDB="P1" S GMRVIEN(GMRVITY)=DA_"^"_GMRDAT(GMRVITY)_"^"_$G(GMRSITE(GMRVITY))
+ S:GMRENTY>4 GLAST=GMRVIDT,GLAST(1)=$G(GLAST(1))+1
+ ; for VOE Pediatric Growth Charts
+ I "8920"[(+GMRVIT(1)) D EN^GMRVPGC(DFN) ; 8=Height 9=Weight 20=Circumference
+ Q
+XREF(DA) ; Set cross-references for FILE 120.5 entry
+ ; Execute SET logic only. Set's all cross-references for this entry.
+ ; DA is the record number
+ N DIC,DIK,X,Y
+ Q:'DA
+ S DIK="^GMR(120.5,"
+ D IX1^DIK
+ Q
+XREF1(DA) ; Set cross-references for FILE 120.5 entry
+ ; Execute SET logic only. Set's all cross-references for this entry.
+ ; DA is the record number
+ N DIC,DIK,GMRVDA,GMRVIEN,X,Y
+ Q:'DA
+ S GMRVIEN=0,GMRVDA=DA
+ F S GMRVIEN=$O(^GMR(120.5,GMRVDA,5,GMRVIEN)) Q:'GMRVIEN D
+ .S DA(1)=GMRVDA,DA=GMRVIEN
+ .S DIK="^GMR(120.5,DA(1),5,"
+ .D IX1^DIK
+ .Q
+ Q
+SETPRMT ; SET VITAL TYPE PATTERN MATCH
+ S G=$P(GMRSTR(0),";",GMRX)
+ S GMRHELP=GMRHELP_$S(G="P":"PPP",G="WT":"WWW.WW",G="R":"RR",G="CG":"NNN.NN",G="CVP":"NN",G="PO2":"NNN",G="HT":"HH",G="BP":"BBB/BBB/BBB (or BBB/BBB)",G="T":"TTT.T",G="PN":"NN",1:"")_$S(GMRX'=($L(GMRSTR(0),";")-1):"-",1:"")
+ S GMRHELP(1)=GMRHELP(1)_$S(GMRHELP(1)'="":",",1:"")_$P(GMRSTR(0),";",GMRX)_"^GMRVUT1"
+ S GMRPRMT=GMRPRMT_$S(G="T":"Temp",G="P":"Pulse",G="WT":"Wt.",G="R":"Resp",G="HT":"Ht.",G="BP":"BP",G="CG":"Circumference/Girth",G="CVP":"CVP",G="PO2":"PO2",G="PN":"Pain",1:"")_$S(GMRX'=($L(GMRSTR(0),";")-1):"-",1:"")
+ Q
+CHKDT(GMVDT,GMVSAV) ;Check if there is an entry for that date & time
+ N GMVA,GMVTY
+ S GMVA=0
+ F S GMVA=$O(^GMR(120.5,"B",GMVDT,GMVA)) Q:'GMVA D
+ .I DFN'=$P($G(^GMR(120.5,GMVA,0)),U,2) Q
+ .S GMVTY=$P($G(^GMR(120.5,GMVA,0)),"^",3)
+ .I GMVTY=GMVSAV D
+ ..S GMVDT=$$FMADD^XLFDT(GMVDT,"","","",1)
+ ..Q
+ .Q
+ Q GMVDT
+ ;
+ADDQUAL(GMRVDATA) ; Add qualifiers to FILE 120.5 entry
+ ; ADD QUALIFIER TO 120.505 SUBFILE
+ ; Input:
+ ; GMRVDATA=120.5 IEN^QUALIFIER (120.52) IEN
+ ;
+ N GMVCNT,GMVERR,GMVFDA,GMVOKAY,GMRVIEN,GMRVQUAL
+ S GMRVIEN=+$P(GMRVDATA,"^",1) ;File 120.5 ien
+ S GMRVQUAL=+$P(GMRVDATA,"^",2) ;File 120.52 ien
+ ; Does File 120.5 entry exist?
+ I '$D(^GMR(120.5,GMRVIEN,0)) Q
+ ; Is the qualifier already stored?
+ I $O(^GMR(120.5,GMRVIEN,5,"B",GMRVQUAL,0))>0 Q
+ ; Legitimate Qualifier?
+ I '$D(^GMRD(120.52,GMRVQUAL,0)) Q
+ S GMVCNT=0 ;counter for number of tries to lock an entry
+B2 ; Lock the entry
+ I GMVCNT>3 Q ;4 strikes and you're out
+ L +^GMR(120.5,GMRVIEN,0):1
+ S GMVCNT=GMVCNT+1
+ I '$T L -^GMR(120.5,GMRVIEN,0) G B2
+ ; Store the qualifier
+ S GMVFDA(120.505,"+1,"_GMRVIEN_",",.01)=GMRVQUAL
+ D UPDATE^DIE("","GMVFDA","GMVOKAY","GMVERR")
+ L -^GMR(120.5,GMRVIEN,0)
+ Q
Index: /PGC/tags/PHP-PGC/GMRVPGC.m
===================================================================
--- /PGC/tags/PHP-PGC/GMRVPGC.m (revision 1504)
+++ /PGC/tags/PHP-PGC/GMRVPGC.m (revision 1504)
@@ -0,0 +1,117 @@
+GMRVPGC ;DBA/CJS - Pediatric Growth Chart HTML generator ;9/26/10 21:59
+ ;;5.0;GEN. MED. REC. - VITALS;**[patch list]**;Oct 31, 2002;Build 15
+ ;
+EN(DFN) ;
+ N BMI,DIC,DIV,IO,LABEL,LINE,MAXAGE,NAME,NONE,POP,REF,ROOT,SERVER,SEX,STYLE,TMP,TYPE,VAL,VDT,XPARSYS,XQDIC,XQPSM,XQVOL,XVALS,YVALS
+ S SERVER=$$GET^XPAR("SYS","GMRV PED GROWTH CHART SERVER")
+ S ROOT=$$GET^XPAR("SYS","GMRV PED GROWTH CHART FOLDER")
+ ;
+ S D=^DPT(DFN,0),NAME=$P(D,U),SEX=$P(D,U,2),SEX=$S(SEX="M":1,SEX="F":2,1:0),DOB=$P(D,U,3),DOD=$P($G(^DPT(DFN,.35)),U),PID=$P($G(^DPT(DFN,.36)),U,3)
+ S Y=DOB D DD^%DT S BIRTH=Y,MAXAGE=$$MNTHSOLD($S(DOD="":DT,DOD'="":DOD),DOB)
+ ;
+ ; See if there are any pediatric vitals to be had
+ ; ^GMR(120.5,"AA",GMRVDFN,GMRVTYP,9999999-GMRVDT,DA)="" "rate" on 0 node piece 8
+ ; types: 8 = Height, 9 - Weight, 20 = Circumference/Girth, 73 - Head qualifier
+ S NONE=1 F TYPE=8,9,20 D
+ . S XVALS(TYPE)="",YVALS(TYPE)=""
+ . S VDT=0 F S VDT=$O(^GMR(120.5,"AA",DFN,TYPE,VDT)) Q:VDT'>0 D
+ . . S DA=+$O(^GMR(120.5,"AA",DFN,TYPE,VDT,0))
+ . . I TYPE=20 Q:'$D(^GMR(120.5,DA,5,"B",73)) ; Quit if not "HEAD"
+ . . Q:+$G(^GMR(120.5,DA,2)) ; Quit if Entered in Error
+ . . S AGE=$$MNTHSOLD(9999999-VDT,DOB),NONE=0
+ . . S XVALS(TYPE)=XVALS(TYPE)_","_AGE
+ . . S VAL=$P(^GMR(120.5,DA,0),U,8),VAL=$S("8,20"[TYPE:VAL*2.54,TYPE=9:VAL/2.2),VAL=$$ROUND(VAL)
+ . . I TYPE=8!(TYPE=9) S BMI(AGE,TYPE)=VAL
+ . . S YVALS(TYPE)=YVALS(TYPE)_","_VAL
+ . . Q
+ . Q
+ ;
+ ; BMI=WEIGHT/(HEIGHT**2) Weight in Kg, Height in meters
+ S AGE="",XVALS("BMI")="",YVALS("BMI")="",XVALS("WTHT")="",YVALS("WTHT")=""
+ F S AGE=$O(BMI(AGE)) Q:AGE'>0 I $D(BMI(AGE,8)),$D(BMI(AGE,9)) D
+ . S DIV=BMI(AGE,8)**2
+ . S:DIV'=0 XVALS("BMI")=XVALS("BMI")_","_AGE,YVALS("BMI")=YVALS("BMI")_","_$$ROUND(10000*BMI(AGE,9)/DIV)
+ . S XVALS("WTHT")=XVALS("WTHT")_","_BMI(AGE,8),YVALS("WTHT")=YVALS("WTHT")_","_BMI(AGE,9)
+ . Q
+ ;
+ ; Establish HTML doctype & head
+ S LINE=0 F S LINE=LINE+1,TMP(LINE)=$P($T(HEAD+LINE),";",3) Q:TMP(LINE)=""
+ ;
+ ; Set up the href links
+ S TMP(LINE)=""_NAME_"
DOB: "_BIRTH_"
",LINE=LINE+1
+ S REF="
"
+ S LABEL(1)=$S(SEX=1:"Male",1:"Female")_" Age in months vs. Length centimeters 0-36 months"
+ S LABEL(2)=$S(SEX=1:"Male",1:"Female")_" Age in months vs Head Circumference in centimeters 0-36 months"
+ S LABEL(4)=$S(SEX=1:"Male",1:"Female")_" Age in months vs. Height centimeters over 36 months"
+ S LABEL(5)=$S(SEX=1:"Male",1:"Female")_" Body Mass Index-for age"
+ S LABEL(6)=$S(SEX=1:"Male",1:"Female")_" Weight vs Stature"
+ S LABEL(7)=$S(SEX=1:"Male",1:"Female")_" Weight vs Length"
+ S TITLE(0)=$S(SEX=1:"Male",1:"Female")_" Age in months vs. Weight in kilograms"
+ S TITLE(1)=$S(SEX=1:"Male",1:"Female")_" Age in months vs. Length centimeters for 0-36 months"
+ S TITLE(2)=$S(SEX=1:"Male",1:"Female")_" Age in months vs Head Circumference in centimeters for 0-36 months"
+ S TITLE(4)=$S(SEX=1:"Male",1:"Female")_" Age in months vs. Height centimeters over 36 months"
+ S TITLE(5)=$S(SEX=1:"Male",1:"Female")_" Body Mass Index vs. Age in Months from 24-240 Months"
+ S TITLE(6)=$S(SEX=1:"Male",1:"Female")_" Weight in Kilograms vs. Height in centimeters"
+ S TITLE(7)=$S(SEX=1:"Male",1:"Female")_" Weight in Kilograms vs. Length in centimeters"
+ F STYLE=0,1,2,4,5,6,7 S TYPE=$$TYPE(STYLE) D:$L(XVALS(TYPE))
+ . Q:("456"[STYLE)&(MAXAGE<36)
+ . S TMP(LINE)=REF_SERVER_"?style="_$$STRING(STYLE)_"&title="_TITLE(STYLE)_"&sex="_SEX_"&maxage="_$$AGE(MAXAGE,STYLE)_"&xvals="_$P(XVALS(TYPE),",",2,99)_"&yvals="_$P(YVALS(TYPE),",",2,99)_""">"_LABEL(STYLE)
+ . S LINE=LINE+1
+ . Q
+ ;
+ S:NONE TMP(LINE)="THERE ARE NO GROWTH VITALS TO PLOT.
",LINE=LINE+1
+ ; last of the labels
+ S TMP(LINE)="Note: should any xvals or yvals value be inappropriate, or there be an unequal number of values in both lists,",LINE=LINE+1
+ S TMP(LINE)="the patient plot will be ignored, and a ""blank"" growth chart with percentile values only will be shown.
",LINE=LINE+1
+ S TMP(LINE)=" "
+ S TMP(LINE+1)="