GMRVXCH3 ;HIRMFO/YH,RM-CONVERT GMRV VITAL CATEGORY FILE ;8/1/96
;;4.0;Vitals/Measurements;;Apr 25, 1997
CONV53 ; Kill off all data in 120.53 file.
; Loop through Category table and build the appropriate 120.53 entry,
; updating the Name, Vital Type, Minimum Entries, Maximum Entries,
; Required Entry, Edit Order, Print Order and Default Qualifier
; fields.
N GMRVCNV,GMRVTYP,GMRVTDA,GMRVGEN,GMRVCHAR,GMRVCNT,GMRVLST
S GMRVLST=0,GMRVCNT=0
S GMRVCAT=""
F S GMRVCAT=$O(^TMP($J,"GMRVCAT",GMRVCAT)) Q:GMRVCAT="" D
. S X=GMRVCAT,DIC="^GMRD(120.53,",DIC(0)="L",DLAYGO=120.53
. K DO,DD,DINUM D FILE^DICN Q:+Y'>0
. S GMRVDA=+Y,^TMP($J,"GMRVCAT",GMRVCAT)=GMRVDA
. S GMRVTYP=0
. F S GMRVTYP=$O(^TMP($J,"GMRVCAT",GMRVCAT,GMRVTYP)) Q:GMRVTYP'>0 D
. . S X=GMRVTYP,DA(1)=GMRVDA,DIC="^GMRD(120.53,"_DA(1)_",1,"
. . S DIC(0)="L",DLAYGO=120.53,DIC("P")="120.531P" K DO,DD,DINUM
. . D FILE^DICN Q:+Y'>0
. . S $P(^GMRD(120.53,DA(1),1,+Y,0),"^",2)=$G(^TMP($J,"GMRVCAT",GMRVCAT,GMRVTYP))
. . Q
. Q
Q
DEFAULT ;CONVERT DEFAULT TEXT TO POINTER TO ^GMRD(120.52)
N GMRVDA
S GMRVDA=0 F S GMRVDA=$O(^GMRD(120.53,GMRVDA)) Q:GMRVDA'>0 S GMRVDA(1)=0 F S GMRVDA(1)=$O(^GMRD(120.53,GMRVDA,1,GMRVDA(1))) Q:GMRVDA(1)'>0 D
. S GMRVDA(2)=$P($G(^GMRD(120.53,GMRVDA,1,GMRVDA(1),0)),"^",7) Q:GMRVDA(2)=""!($D(^GMRD(120.52,+GMRVDA(2),0)))
. S $P(^GMRD(120.53,GMRVDA,1,GMRVDA(1),0),"^",7)=$S($D(^GMRD(120.52,"B",GMRVDA(2))):$O(^GMRD(120.52,"B",GMRVDA(2),0)),1:"")
. Q
Q
OLD ; THE QUALIFIER ALREADY EXISTS
S GMRVCHA(1)=$O(^GMRD(120.52,"B",GMRVCHA,0)) Q:GMRVCHA(1)'>0
Q:$D(^GMRD(120.52,GMRVCHA(1),1,"B",GMRVTYP(1)))
I '$D(^GMRD(120.52,GMRVCHA(1),1,0)) S ^GMRD(120.52,GMRVCHA(1),1,0)="^120.521P^0^0"
S GDA=+$P(^GMRD(120.52,GMRVCHA(1),1,0),"^",3)+1
S ^GMRD(120.52,GMRVCHA(1),1,GDA,0)=GMRVTYP(1)_"^"_GMRVCAT(1)_"^"_$P(GMRVLINE,"^",2,3)
S ^GMRD(120.52,GMRVCHA(1),1,"B",GMRVTYP(1),GDA)="",^GMRD(120.52,"C",GMRVTYP(1),GMRVCHA(1),GDA)=""
S $P(^GMRD(120.52,GMRVCHA(1),1,0),"^",3)=GDA,$P(^(0),"^",4)=$P(^(0),"^",4)+1
Q
NEW ;NEW QUALIFIER
S GDA=+$P(^GMRD(120.52,0),"^",3)+1
S ^GMRD(120.52,GDA,0)=GMRVCHA,^GMRD(120.52,GDA,1,0)="^120.521P^1^1"
S ^GMRD(120.52,"B",GMRVCHA,GDA)=""
S ^GMRD(120.52,GDA,1,1,0)=GMRVTYP(1)_"^"_GMRVCAT(1)_"^"_$P(GMRVLINE,"^",2,3)
S ^GMRD(120.52,GDA,1,"B",GMRVTYP(1),1)=""
S ^GMRD(120.52,"C",GMRVTYP(1),GDA,1)=""
S $P(^GMRD(120.52,0),"^",3)=GDA,$P(^(0),"^",4)=$P(^(0),"^",4)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVXCH3 2471 printed Oct 16, 2024@17:58:37 Page 2
GMRVXCH3 ;HIRMFO/YH,RM-CONVERT GMRV VITAL CATEGORY FILE ;8/1/96
+1 ;;4.0;Vitals/Measurements;;Apr 25, 1997
CONV53 ; Kill off all data in 120.53 file.
+1 ; Loop through Category table and build the appropriate 120.53 entry,
+2 ; updating the Name, Vital Type, Minimum Entries, Maximum Entries,
+3 ; Required Entry, Edit Order, Print Order and Default Qualifier
+4 ; fields.
+5 NEW GMRVCNV,GMRVTYP,GMRVTDA,GMRVGEN,GMRVCHAR,GMRVCNT,GMRVLST
+6 SET GMRVLST=0
SET GMRVCNT=0
+7 SET GMRVCAT=""
+8 FOR
SET GMRVCAT=$ORDER(^TMP($JOB,"GMRVCAT",GMRVCAT))
if GMRVCAT=""
QUIT
Begin DoDot:1
+9 SET X=GMRVCAT
SET DIC="^GMRD(120.53,"
SET DIC(0)="L"
SET DLAYGO=120.53
+10 KILL DO,DD,DINUM
DO FILE^DICN
if +Y'>0
QUIT
+11 SET GMRVDA=+Y
SET ^TMP($JOB,"GMRVCAT",GMRVCAT)=GMRVDA
+12 SET GMRVTYP=0
+13 FOR
SET GMRVTYP=$ORDER(^TMP($JOB,"GMRVCAT",GMRVCAT,GMRVTYP))
if GMRVTYP'>0
QUIT
Begin DoDot:2
+14 SET X=GMRVTYP
SET DA(1)=GMRVDA
SET DIC="^GMRD(120.53,"_DA(1)_",1,"
+15 SET DIC(0)="L"
SET DLAYGO=120.53
SET DIC("P")="120.531P"
KILL DO,DD,DINUM
+16 DO FILE^DICN
if +Y'>0
QUIT
+17 SET $PIECE(^GMRD(120.53,DA(1),1,+Y,0),"^",2)=$GET(^TMP($JOB,"GMRVCAT",GMRVCAT,GMRVTYP))
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
DEFAULT ;CONVERT DEFAULT TEXT TO POINTER TO ^GMRD(120.52)
+1 NEW GMRVDA
+2 SET GMRVDA=0
FOR
SET GMRVDA=$ORDER(^GMRD(120.53,GMRVDA))
if GMRVDA'>0
QUIT
SET GMRVDA(1)=0
FOR
SET GMRVDA(1)=$ORDER(^GMRD(120.53,GMRVDA,1,GMRVDA(1)))
if GMRVDA(1)'>0
QUIT
Begin DoDot:1
+3 SET GMRVDA(2)=$PIECE($GET(^GMRD(120.53,GMRVDA,1,GMRVDA(1),0)),"^",7)
if GMRVDA(2)=""!($DATA(^GMRD(120.52,+GMRVDA(2),0)))
QUIT
+4 SET $PIECE(^GMRD(120.53,GMRVDA,1,GMRVDA(1),0),"^",7)=$SELECT($DATA(^GMRD(120.52,"B",GMRVDA(2))):$ORDER(^GMRD(120.52,"B",GMRVDA(2),0)),1:"")
+5 QUIT
End DoDot:1
+6 QUIT
OLD ; THE QUALIFIER ALREADY EXISTS
+1 SET GMRVCHA(1)=$ORDER(^GMRD(120.52,"B",GMRVCHA,0))
if GMRVCHA(1)'>0
QUIT
+2 if $DATA(^GMRD(120.52,GMRVCHA(1),1,"B",GMRVTYP(1)))
QUIT
+3 IF '$DATA(^GMRD(120.52,GMRVCHA(1),1,0))
SET ^GMRD(120.52,GMRVCHA(1),1,0)="^120.521P^0^0"
+4 SET GDA=+$PIECE(^GMRD(120.52,GMRVCHA(1),1,0),"^",3)+1
+5 SET ^GMRD(120.52,GMRVCHA(1),1,GDA,0)=GMRVTYP(1)_"^"_GMRVCAT(1)_"^"_$PIECE(GMRVLINE,"^",2,3)
+6 SET ^GMRD(120.52,GMRVCHA(1),1,"B",GMRVTYP(1),GDA)=""
SET ^GMRD(120.52,"C",GMRVTYP(1),GMRVCHA(1),GDA)=""
+7 SET $PIECE(^GMRD(120.52,GMRVCHA(1),1,0),"^",3)=GDA
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
+8 QUIT
NEW ;NEW QUALIFIER
+1 SET GDA=+$PIECE(^GMRD(120.52,0),"^",3)+1
+2 SET ^GMRD(120.52,GDA,0)=GMRVCHA
SET ^GMRD(120.52,GDA,1,0)="^120.521P^1^1"
+3 SET ^GMRD(120.52,"B",GMRVCHA,GDA)=""
+4 SET ^GMRD(120.52,GDA,1,1,0)=GMRVTYP(1)_"^"_GMRVCAT(1)_"^"_$PIECE(GMRVLINE,"^",2,3)
+5 SET ^GMRD(120.52,GDA,1,"B",GMRVTYP(1),1)=""
+6 SET ^GMRD(120.52,"C",GMRVTYP(1),GDA,1)=""
+7 SET $PIECE(^GMRD(120.52,0),"^",3)=GDA
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
+8 QUIT
