Routine: BGOVIF

BGOVIF ; IHS/BAO/TMD - Manage V INFANT FFEDING ;10-Dec-2013 14:09;DU

 ;;1.1;BGO COMPONENTS;**1,3,6,11,13**;Mar 20, 2007;Build 16

 ;---------------------------------------------

 ; Return entries from V Infant Feeding by V File Entry or by Patient or by Visit

 ;  INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]

GET(RET,INP) ;EP

 N I,X,IFDATE

 D VFGET^BGOUTL2(.RET,INP,$$FNUM,".03;.01;1201;1204")

 ;patch 6 If the 1201 field is empty, replace it with the visit date for display

 S I=0 F  S I=$O(@RET@(I)) Q:I=""  D

 .S X=$G(@RET@(I))

 .I $P(X,U,5)="" D

 ..S IFDATE=$P($P(X,U,3),"|",1)

 ..S $P(X,U,5)=IFDATE_"|"_$$CVTDATE^BGOUTL(IFDATE)

 ..S @RET@(I)=X

 ..S @RET@(I)=X

 .S IEN=$P(X,U,1)

 .S EXTRA=""

 .S EX=0 F  S EX=$O(^AUPNVIF(IEN,13,EX)) Q:'+EX  D

 ..S AIEN=EX_","_IEN

 ..S TYP=$$GET1^DIQ(9000010.4413,AIEN,.01)

 ..Q:TYP=""

 ..S TYPC=$$GET1^DIQ(9000010.4413,AIEN,.01,"I")

 ..S COMM=$$GET1^DIQ(9000010.4413,AIEN,.02)

 ..S EXTRA=$S(EXTRA="":TYP_"|"_TYPC_"|"_COMM,1:EXTRA_"~"_TYP_"|"_TYPC_"|"_COMM)

 ..S $P(X,U,7)=EXTRA

 .S @RET@(I)=X

 ; Add/Edit infant feeding data

 ;  INP = V File IEN ^ Visit IEN ^ Feeding Choice ^ EXTRA

SET(RET,INP) ;EP

 N VIEN,VFIEN,VFNEW,TYPE,FDA,FNUM,EXTRA,CNT,MUL,AIEN

 S RET="",FNUM=$$FNUM

 S VFIEN=$P(INP,U)

 I +VFIEN D DELEX(VFIEN)

 S VFNEW='VFIEN

 S VIEN=$P(INP,U,2)

 S TYPE=$P(INP,U,3)

 S EXTRA=$P(INP,U,4)

 I 'TYPE S RET=$$ERR^BGOUTL(1079) Q

 S RET=$$CHKVISIT^BGOUTL(VIEN)

 Q:RET

 I 'VFIEN D  Q:'VFIEN

 .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)

 .S:RET>0 VFIEN=RET,RET=""

 S FDA=$NA(FDA(FNUM,VFIEN_","))

 S @FDA@(.01)=TYPE

 S @FDA@(1201)="N"

 S @FDA@(1204)="`"_DUZ

 ;Patch 11 Set date entered

 I VFNEW D

 .S @FDA@(1216)="N"

 .S @FDA@(1217)="`"_DUZ

 ;Patch 11 Set last modified

 S @FDA@(1218)="N"

 S @FDA@(1219)="`"_DUZ

 S RET=$$UPDATE^BGOUTL(.FDA,"E")

 I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)

 D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 S:'RET RET=VFIEN

 S CNT=$L(EXTRA,"~")

 S FNUM=9000010.4413

 F I=1:1:CNT D

 .S MUL=$P(EXTRA,"~",I)

 .S MUL=$S(MUL="MILK":1,MUL="FRUIT JUICE":2,MUL="CARBONATED DRINK":3,MUL="SPORTS DRINK":4,MUL="GLUCOSE":5,MUL="WATER":6,1:MUL)

 .S AIEN="+"_I_","_VFIEN_","

 .S FDA(FNUM,AIEN,.01)=$P(MUL,":",1)

 .S FDA(FNUM,AIEN,.02)=$P(MUL,":",2)

 .D UPDATE^DIE(,"FDA","AIEN","ERR")

DELEX(VFIEN) ;Delete existing extras and all SNOMED and LOINC codes

 K NUM,DA,DIK

 S NUM=0 F  S NUM=$O(^AUPNVIF(VFIEN,13,NUM)) Q:NUM=""  D

 .S DA(1)=VFIEN,DA=NUM

 .S DIK="^AUPNVIF(VFIEN,13,"

 .D ^DIK

 K NUM,DA,DIK

 S NUM=0 F  S NUM=$O(^AUPNVIF(VFIEN,26,NUM)) Q:NUM=""  D

 .S DA(1)=VFIEN,DA=NUM

 .S DIK="^AUPNVIF(VFIEN,26,"

 .D ^DIK

 K NUM,DA,DIK

 S NUM=0 F  S NUM=$O(^AUPNVIF(VFIEN,27,NUM)) Q:NUM=""  D

 .S DA(1)=VFIEN,DA=NUM

 .S DIK="^AUPNVIF(VFIEN,27,"

 .D ^DIK

 ; Delete a V File entry

DEL(RET,VFIEN) ;

 D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)

 ; Return V File #

FNUM() Q 9000010.44

BGOVIF    ; IHS/BAO/TMD - Manage V INFANT FFEDING ;10-Dec-2013 14:09;DU

 +1       ;;1.1;BGO COMPONENTS;**1,3,6,11,13**;Mar 20, 2007;Build 16

 +2       ;---------------------------------------------

 +3       ; Return entries from V Infant Feeding by V File Entry or by Patient or by Visit

 +4       ;  INP = Patient IEN [1] ^ V File IEN [2] ^ Visit IEN [3]

GET(RET,INP) ;EP

 +1        NEW I,X,IFDATE

 +2        DO VFGET^BGOUTL2(.RET,INP,$$FNUM,".03;.01;1201;1204")

 +3       ;patch 6 If the 1201 field is empty, replace it with the visit date for display

 +4        SET I=0

FOR

               SET I=$ORDER(@RET@(I))

               IF I=""

                   QUIT

               Begin DoDot:1

 +5                SET X=$GET(@RET@(I))

 +6                IF $PIECE(X,U,5)=""

                       Begin DoDot:2

 +7                        SET IFDATE=$PIECE($PIECE(X,U,3),"|",1)

 +8                        SET $PIECE(X,U,5)=IFDATE_"|"_$$CVTDATE^BGOUTL(IFDATE)

 +9                        SET @RET@(I)=X

 +10                       SET @RET@(I)=X

                       End DoDot:2

 +11               SET IEN=$PIECE(X,U,1)

 +12               SET EXTRA=""

 +13               SET EX=0

FOR

                       SET EX=$ORDER(^AUPNVIF(IEN,13,EX))

                       IF '+EX

                           QUIT

                       Begin DoDot:2

 +14                       SET AIEN=EX_","_IEN

 +15                       SET TYP=$$GET1^DIQ(9000010.4413,AIEN,.01)

 +16                       IF TYP=""

                               QUIT

 +17                       SET TYPC=$$GET1^DIQ(9000010.4413,AIEN,.01,"I")

 +18                       SET COMM=$$GET1^DIQ(9000010.4413,AIEN,.02)

 +19                       SET EXTRA=$SELECT(EXTRA="":TYP_"|"_TYPC_"|"_COMM,1:EXTRA_"~"_TYP_"|"_TYPC_"|"_COMM)

 +20                       SET $PIECE(X,U,7)=EXTRA

                       End DoDot:2

 +21               SET @RET@(I)=X

               End DoDot:1

 +22       QUIT

 +23      ; Add/Edit infant feeding data

 +24      ;  INP = V File IEN ^ Visit IEN ^ Feeding Choice ^ EXTRA

SET(RET,INP) ;EP

 +1        NEW VIEN,VFIEN,VFNEW,TYPE,FDA,FNUM,EXTRA,CNT,MUL,AIEN

 +2        SET RET=""

           SET FNUM=$$FNUM

 +3        SET VFIEN=$PIECE(INP,U)

 +4        IF +VFIEN

               DO DELEX(VFIEN)

 +5        SET VFNEW='VFIEN

 +6        SET VIEN=$PIECE(INP,U,2)

 +7        SET TYPE=$PIECE(INP,U,3)

 +8        SET EXTRA=$PIECE(INP,U,4)

 +9        IF 'TYPE

               SET RET=$$ERR^BGOUTL(1079)

               QUIT

 +10       SET RET=$$CHKVISIT^BGOUTL(VIEN)

 +11       IF RET

               QUIT

 +12       IF 'VFIEN

               Begin DoDot:1

 +13               DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)

 +14               IF RET>0

                       SET VFIEN=RET

                       SET RET=""

               End DoDot:1

               IF 'VFIEN

                   QUIT

 +15       SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +16       SET @FDA@(.01)=TYPE

 +17       SET @FDA@(1201)="N"

 +18       SET @FDA@(1204)="`"_DUZ

 +19      ;Patch 11 Set date entered

 +20       IF VFNEW

               Begin DoDot:1

 +21               SET @FDA@(1216)="N"

 +22               SET @FDA@(1217)="`"_DUZ

               End DoDot:1

 +23      ;Patch 11 Set last modified

 +24       SET @FDA@(1218)="N"

 +25       SET @FDA@(1219)="`"_DUZ

 +26       SET RET=$$UPDATE^BGOUTL(.FDA,"E")

 +27       IF RET

               IF VFNEW

                   IF $$DELETE^BGOUTL(FNUM,VFIEN)

 +28       IF 'RET

               DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 +29       IF 'RET

               SET RET=VFIEN

 +30       SET CNT=$LENGTH(EXTRA,"~")

 +31       SET FNUM=9000010.4413

 +32       FOR I=1:1:CNT

               Begin DoDot:1

 +33               SET MUL=$PIECE(EXTRA,"~",I)

 +34               SET MUL=$SELECT(MUL="MILK":1,MUL="FRUIT JUICE":2,MUL="CARBONATED DRINK":3,MUL="SPORTS DRINK":4,MUL="GLUCOSE":5,MUL="WATER":6,1:MUL)

 +35               SET AIEN="+"_I_","_VFIEN_","

 +36               SET FDA(FNUM,AIEN,.01)=$PIECE(MUL,":",1)

 +37               SET FDA(FNUM,AIEN,.02)=$PIECE(MUL,":",2)

 +38               DO UPDATE^DIE(,"FDA","AIEN","ERR")

               End DoDot:1

 +39       QUIT

DELEX(VFIEN) ;Delete existing extras and all SNOMED and LOINC codes

 +1        KILL NUM,DA,DIK

 +2        SET NUM=0

FOR

               SET NUM=$ORDER(^AUPNVIF(VFIEN,13,NUM))

               IF NUM=""

                   QUIT

               Begin DoDot:1

 +3                SET DA(1)=VFIEN

                   SET DA=NUM

 +4                SET DIK="^AUPNVIF(VFIEN,13,"

 +5                DO ^DIK

               End DoDot:1

 +6        KILL NUM,DA,DIK

 +7        SET NUM=0

FOR

               SET NUM=$ORDER(^AUPNVIF(VFIEN,26,NUM))

               IF NUM=""

                   QUIT

               Begin DoDot:1

 +8                SET DA(1)=VFIEN

                   SET DA=NUM

 +9                SET DIK="^AUPNVIF(VFIEN,26,"

 +10               DO ^DIK

               End DoDot:1

 +11       KILL NUM,DA,DIK

 +12       SET NUM=0

FOR

               SET NUM=$ORDER(^AUPNVIF(VFIEN,27,NUM))

               IF NUM=""

                   QUIT

               Begin DoDot:1

 +13               SET DA(1)=VFIEN

                   SET DA=NUM

 +14               SET DIK="^AUPNVIF(VFIEN,27,"

 +15               DO ^DIK

               End DoDot:1

 +16       QUIT

 +17      ; Delete a V File entry

DEL(RET,VFIEN) ;

 +1        DO VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)

 +2        QUIT

 +3       ; Return V File #

FNUM()     QUIT 9000010.44

BGOVIF.m