- FHSYSP ; HISC/REL - Site Parameter Edit ;3/20/95 07:53
- ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
- S DA=1,DIE="^FH(119.9,"
- I '$D(^FH(119.9,DA,0)) S DR=".01///"_DA D ^DIE
- W ! S DR="3;22;4;S:X="""" Y=9;5:8;40:49;9:13;50:59;14:18;25:39;100//Y;I X'=""Y"" S Y="""";99" D ^DIE G KIL
- EN1 ; Display Selected Lab Tests
- W ! S L=0,DIC="^FH(119.9,",FLDS="[FHSYP1]",BY="@SITE"
- S (FR,TO)=1,DHD="SELECTED LABORATORY TESTS" D EN1^DIP,RSET Q
- EN2 ; Display Selected Drug Classifications
- W ! S L=0,DIC="^FH(119.9,",FLDS="[FHSYP2]",BY="@SITE"
- S (FR,TO)=1,DHD="SELECTED DRUG CLASSIFICATIONS" D EN1^DIP,RSET Q
- EN3 ; Clinical Site Parameters
- S DA=1,DIE="^FH(119.9,",DR="[FHSITEC1]" W ! D ^DIE G KIL
- RSET K %ZIS S IOP="" D ^%ZIS
- KIL G KILL^XUSCLEAN
- TIM ; Convert to printable time
- I $L(X)>6!($L(X)<2) G ERR
- I X'["A",X'["P" G ERR
- S:$L(X)<4 X=$E(X,1,$L(X)-1)_"00"_$E(X,$L(X))
- I X[":",X?1.2N1":"2N1"A"!(X?1.2N1":"2N1"P") S X=+$P(X,":",1)_$P(X,":",2) G 1
- I X'[":",X?3.4N1"A"!(X?3.4N1"P") G 1
- ERR W *7," Enter time as 8:15A or 12:30P" K X Q
- 1 I X#100>59!(X>1259)!(X<1) G ERR
- I X<1000 S:$E(X,1) X="0"_X
- S X=+$E(X,1,2)_":"_$E(X,3,4)_$S(X["A":"A",1:"P") Q
- MIL ; Check for AM or PM
- S X1=$P(X,":",1)_$P(X,":",2),X1=+X1
- I X["P",X1<1200 S X1=X1+1200
- I X["A",X1>1200 S X1=X1-1200
- Q
- MIP ; Get the printable time
- S Z=$S(Y<1200:"A",1:"P") I Z="P",Y>1259 S Y=Y-1200
- S Y=$E("000"_Y,$L(Y),$L(Y)+3),Y=+$E(Y,1,2)_":"_$E(Y,3,4)_Z Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHSYSP 1445 printed Feb 18, 2025@23:21:34 Page 2
- FHSYSP ; HISC/REL - Site Parameter Edit ;3/20/95 07:53
- +1 ;;5.5;DIETETICS;**2,5**;Jan 28, 2005;Build 53
- +2 SET DA=1
- SET DIE="^FH(119.9,"
- +3 IF '$DATA(^FH(119.9,DA,0))
- SET DR=".01///"_DA
- DO ^DIE
- +4 WRITE !
- SET DR="3;22;4;S:X="""" Y=9;5:8;40:49;9:13;50:59;14:18;25:39;100//Y;I X'=""Y"" S Y="""";99"
- DO ^DIE
- GOTO KIL
- EN1 ; Display Selected Lab Tests
- +1 WRITE !
- SET L=0
- SET DIC="^FH(119.9,"
- SET FLDS="[FHSYP1]"
- SET BY="@SITE"
- +2 SET (FR,TO)=1
- SET DHD="SELECTED LABORATORY TESTS"
- DO EN1^DIP
- DO RSET
- QUIT
- EN2 ; Display Selected Drug Classifications
- +1 WRITE !
- SET L=0
- SET DIC="^FH(119.9,"
- SET FLDS="[FHSYP2]"
- SET BY="@SITE"
- +2 SET (FR,TO)=1
- SET DHD="SELECTED DRUG CLASSIFICATIONS"
- DO EN1^DIP
- DO RSET
- QUIT
- EN3 ; Clinical Site Parameters
- +1 SET DA=1
- SET DIE="^FH(119.9,"
- SET DR="[FHSITEC1]"
- WRITE !
- DO ^DIE
- GOTO KIL
- RSET KILL %ZIS
- SET IOP=""
- DO ^%ZIS
- KIL GOTO KILL^XUSCLEAN
- TIM ; Convert to printable time
- +1 IF $LENGTH(X)>6!($LENGTH(X)<2)
- GOTO ERR
- +2 IF X'["A"
- IF X'["P"
- GOTO ERR
- +3 if $LENGTH(X)<4
- SET X=$EXTRACT(X,1,$LENGTH(X)-1)_"00"_$EXTRACT(X,$LENGTH(X))
- +4 IF X[":"
- IF X?1.2N1":"2N1"A"!(X?1.2N1":"2N1"P")
- SET X=+$PIECE(X,":",1)_$PIECE(X,":",2)
- GOTO 1
- +5 IF X'[":"
- IF X?3.4N1"A"!(X?3.4N1"P")
- GOTO 1
- ERR WRITE *7," Enter time as 8:15A or 12:30P"
- KILL X
- QUIT
- 1 IF X#100>59!(X>1259)!(X<1)
- GOTO ERR
- +1 IF X<1000
- if $EXTRACT(X,1)
- SET X="0"_X
- +2 SET X=+$EXTRACT(X,1,2)_":"_$EXTRACT(X,3,4)_$SELECT(X["A":"A",1:"P")
- QUIT
- MIL ; Check for AM or PM
- +1 SET X1=$PIECE(X,":",1)_$PIECE(X,":",2)
- SET X1=+X1
- +2 IF X["P"
- IF X1<1200
- SET X1=X1+1200
- +3 IF X["A"
- IF X1>1200
- SET X1=X1-1200
- +4 QUIT
- MIP ; Get the printable time
- +1 SET Z=$SELECT(Y<1200:"A",1:"P")
- IF Z="P"
- IF Y>1259
- SET Y=Y-1200
- +2 SET Y=$EXTRACT("000"_Y,$LENGTH(Y),$LENGTH(Y)+3)
- SET Y=+$EXTRACT(Y,1,2)_":"_$EXTRACT(Y,3,4)_Z
- QUIT
