- 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 Feb 18, 2025@23:24:18 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
