FHIPST7.m

FHIPST7	; HISC/NCA - Annual Report Date Field Conversion ;1/5/94  15:09

	;;5.0;Dietetics;;Oct 11, 1995

EN1	; Check if field for Pat Sat is Date

	D NOW^%DTC S NOW=%\1

	F PRE=0:0 S PRE=$O(^FH(117.3,PRE)) Q:PRE<1  D FIND

	D TF

	K %,%H,%I,%T,FHDTE,FHX1,FHX2,L1,LP,LST,NOW,PRE,TUN,X,ZZ D ^FHXMOV Q

FIND	; Find all data entered pointing to entries 18 and 19 in

	; file 117.4

	I $D(^FH(117.3,PRE,2)) K ^FH(117.3,PRE,2)

	F L1=0:0 S L1=$O(^FH(117.3,PRE,"SPEC",L1)) Q:L1<1  S FHX2=$G(^(L1,0)) I +FHX2=18!(+FHX2=19) D REMOV

	Q

REMOV	; Remove the entries found and the B cross ref

	K ^FH(117.3,PRE,"SPEC",L1,0)

	K ^FH(117.3,PRE,"SPEC","B",+FHX2,L1)

	S ZZ=^FH(117.3,PRE,"SPEC",0) S:$P(ZZ,"^",3)=L1 $P(ZZ,"^",3)=$P(ZZ,"^",3)-1

	S $P(^FH(117.3,PRE,"SPEC",0),"^",3,4)=$P(ZZ,"^",3)_"^"_($P(ZZ,"^",4)-1)

	Q

TF	; Convert Tubefeeding CC/Unit data to Amt/Unit

	F TUN=0:0 S TUN=$O(^FH(118.2,TUN)) Q:TUN<1  S X=$P($G(^(TUN,0)),"^",3) D CHG

	Q

CHG	I X,$E(X,$L(X))'?1U S X=X_"C",$P(^FH(118.2,TUN,0),"^",3)=X

	Q

FHIPST7   ; HISC/NCA - Annual Report Date Field Conversion ;1/5/94  15:09

 +1       ;;5.0;Dietetics;;Oct 11, 1995

EN1       ; Check if field for Pat Sat is Date

 +1        DO NOW^%DTC

           SET NOW=%\1

 +2        FOR PRE=0:0

               SET PRE=$ORDER(^FH(117.3,PRE))

               IF PRE<1

                   QUIT 

               DO FIND

 +3        DO TF

 +4        KILL %,%H,%I,%T,FHDTE,FHX1,FHX2,L1,LP,LST,NOW,PRE,TUN,X,ZZ

           DO ^FHXMOV

           QUIT 

FIND      ; Find all data entered pointing to entries 18 and 19 in

 +1       ; file 117.4

 +2        IF $DATA(^FH(117.3,PRE,2))

               KILL ^FH(117.3,PRE,2)

 +3        FOR L1=0:0

               SET L1=$ORDER(^FH(117.3,PRE,"SPEC",L1))

               IF L1<1

                   QUIT 

               SET FHX2=$GET(^(L1,0))

               IF +FHX2=18!(+FHX2=19)

                   DO REMOV

 +4        QUIT 

REMOV     ; Remove the entries found and the B cross ref

 +1        KILL ^FH(117.3,PRE,"SPEC",L1,0)

 +2        KILL ^FH(117.3,PRE,"SPEC","B",+FHX2,L1)

 +3        SET ZZ=^FH(117.3,PRE,"SPEC",0)

           IF $PIECE(ZZ,"^",3)=L1

               SET $PIECE(ZZ,"^",3)=$PIECE(ZZ,"^",3)-1

 +4        SET $PIECE(^FH(117.3,PRE,"SPEC",0),"^",3,4)=$PIECE(ZZ,"^",3)_"^"_($PIECE(ZZ,"^",4)-1)

 +5        QUIT 

TF        ; Convert Tubefeeding CC/Unit data to Amt/Unit

 +1        FOR TUN=0:0

               SET TUN=$ORDER(^FH(118.2,TUN))

               IF TUN<1

                   QUIT 

               SET X=$PIECE($GET(^(TUN,0)),"^",3)

               DO CHG

 +2        QUIT 

CHG        IF X

               IF $EXTRACT(X,$LENGTH(X))'?1U

                   SET X=X_"C"

                   SET $PIECE(^FH(118.2,TUN,0),"^",3)=X

 +1        QUIT