- BDMFTAX3 ; cmi/anch/maw - DMS TAXONOMY MANAGEMENT UTILITY ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
- ;UTILITY PROGRAM TO MANAGE TAXONOMY CREATION AND EDITING
- ;
- ;IT IS NOW INCLUDED WITH PATCH #5 THOUGH DOES NOT APPEAR
- ;TO BE CALLED FROM ANY OTHER ROUTINE OR DICTIONARY OR
- ;MENU OPTION
- ;
- TAX ;CREATE TAXONOMIES
- ;REMOVED CODE IN 2.0 DISTRIBUTION
- Q
- ZIS W !!,"This process will update Taxonomies required by the"
- W !,"DIABETES MANAGEMENT SYSTEM."
- W !!,"Select the device on which to record taxonomies updated."
- W !!,"Enter the name of a device for the report or"
- W !,"enter '^' to exit the update process then press <ENTER>."
- S DIR(0)="YO"
- S DIR("A")="Do you want to proceed"
- S DIR("B")="YES"
- W !
- D DIR^BDMFDIC
- Q:Y'=1
- S (ZTRTN,BDMRTN)="TAXSET^BDMFTAX3"
- S ZTDESC="UPDATE DIABETES SYSTEM TAXONOMIES"
- D ^BDMFZIS
- Q
- TAXSET ;EP;TO UPDATE DIABETES SYSTEM STANDARD TAXONOMIES
- D T1
- K ^TMP("TAXONOMIES")
- Q
- T1 K BDMDA,BDMQUIT
- ;Removed Code from 2.0 Dist
- Q
- DX I $P(Z,";;",2)=11 D
- .I '$D(^ATXAX(BDMDA,11,$P(Z,";;",4),0)) D
- ..S ^ATXAX(BDMDA,11,$P(Z,";;",4),0)=$P(Z,";;",5)
- ..S ^ATXAX(BDMDA,11,0)="^^"_$P(Z,";;",4)_"^"_$P(Z,";;",4)_"^"_DT
- ..I '$D(ZTQUEUED) U IO W !,"FILE DX DESCRIPTION: ",Z
- I $P(Z,";;",2)=21 D
- .S X=$P(Z,";;",6)
- .S:X="" X=$P(Z,";;",5)
- .Q:X=""
- .S YY=$P(X,U),ZZ=$P(X,U,2)
- .I YY]"","^9999999.31^80^80.1^"'[(U_BDMFILE_U) D Q:'YY
- ..S YYY=$G(^DIC(BDMFILE,0,"GL"))
- ..Q:YYY=""
- ..I BDMFILE=50,$P(Z,";;",10)]"" S YY=$P(Z,";;",10),YY=$TR(YY,"-",""),YY=$O(^PSDRUG("ZNDC",YY,0)) Q:$D(^PSDRUG(+YY,0))
- ..S YY=$P(X,U)
- ..S YY=$O(@(YYY_"""B"","""_YY_""",0)"))
- ..I ZZ]"" S ZZ=$O(@(YYY_"""B"","""_ZZ_""",0)"))
- .S:ZZ="" ZZ=YY
- .Q:$D(^ATXAX(BDMDA,21,"B",YY))
- .I '$D(ZTQUEUED) U IO W !?10,"FILE DX ITEM: ",X," ",YY," ",ZZ
- .S X=YY
- .S DA=BDMDA
- .S DA(1)=BDMDA
- .S DIC="^ATXAX("_DA_",21,"
- .I $G(ZZ)]"" S DIC("DR")=".02////"_ZZ K ZZ
- .S:'$D(^ATXAX(DA,21,0)) ^ATXAX(DA,21,0)="^9002226.02101A"
- .S DIC(0)="L"
- .D FILE^BDMFDIC
- Q
- LAB I $P(Z,";;",2)=11 D Q
- .I '$D(^ATXLAB(BDMDA,11,$P(Z,";;",4),0)) D
- ..S ^ATXLAB(BDMDA,11,$P(Z,";;",4),0)=$P(Z,";;",5)
- ..S ^ATXLAB(BDMDA,11,0)="^^"_$P(Z,";;",4)_"^"_$P(Z,";;",4)_"^"_DT
- ..I '$D(ZTQUEUED) U IO W !,"FILE LAB DESCRIPTION: ",Z
- I $P(Z,";;",2)=21,$P(Z,";;",6)'="SOURCE" D
- .S YY=$P(Z,";;",5)
- .I $P($G(^LAB(60,YY,0)),U,12)=$P(Z,";;",7)
- .E D
- ..S YY=$P(Z,";;",6)
- ..Q:YY=""
- ..S YY=$O(^LAB(60,"B",YY,0))
- ..I 'YY,$D(^LAB(60,+$P(Z,";;",5),0)),$E($P(^(0),U),1,5)=$E($P(Z,";;",6),1,5) S YY=$P(Z,";;",5)
- .Q:'YY
- .Q:'$D(^LAB(60,YY,0))
- .S BDMDA(1)=BDMDA
- .Q:$D(^ATXLAB(BDMDA,21,"B",YY))
- .I '$D(ZTQUEUED) U IO W !?10,"FILE LAB ITEM: ",YY
- .S X=YY
- .S DA=BDMDA
- .S DA(1)=BDMDA
- .S DIC="^ATXLAB("_DA_",21,"
- .S DIC(0)="L"
- .S:'$D(^ATXLAB(DA,21,0)) ^ATXLAB(DA,21,0)="^9002228.02101PA"
- .D FILE^BDMFDIC
- .S BDMDA(1)=+Y
- I $G(BDMDA),$G(BDMDA(1)),$P(Z,";;",2)=21,$P(Z,";;",6)="SOURCE" D
- .I $D(^ATXLAB(BDMDA,21,BDMDA(1))),'$D(^ATXLAB(BDMDA,21,BDMDA(1),11,$P(Z,";;",5),0)) D
- ..S ^ATXLAB(BDMDA,21,BDMDA(1),11,$P(Z,";;",5),0)=$P(Z,";;",7)
- ..I '$D(ZTQUEUED) U IO W !?10,"FILE LAB ITEM SOURCE: ",Z
- Q
- BDMFTAX3 ; cmi/anch/maw - DMS TAXONOMY MANAGEMENT UTILITY ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;;AUG 11, 2006
- +2 ;UTILITY PROGRAM TO MANAGE TAXONOMY CREATION AND EDITING
- +3 ;
- +4 ;IT IS NOW INCLUDED WITH PATCH #5 THOUGH DOES NOT APPEAR
- +5 ;TO BE CALLED FROM ANY OTHER ROUTINE OR DICTIONARY OR
- +6 ;MENU OPTION
- +7 ;
- TAX ;CREATE TAXONOMIES
- +1 ;REMOVED CODE IN 2.0 DISTRIBUTION
- +2 QUIT
- ZIS WRITE !!,"This process will update Taxonomies required by the"
- +1 WRITE !,"DIABETES MANAGEMENT SYSTEM."
- +2 WRITE !!,"Select the device on which to record taxonomies updated."
- +3 WRITE !!,"Enter the name of a device for the report or"
- +4 WRITE !,"enter '^' to exit the update process then press <ENTER>."
- +5 SET DIR(0)="YO"
- +6 SET DIR("A")="Do you want to proceed"
- +7 SET DIR("B")="YES"
- +8 WRITE !
- +9 DO DIR^BDMFDIC
- +10 IF Y'=1
- QUIT
- +11 SET (ZTRTN,BDMRTN)="TAXSET^BDMFTAX3"
- +12 SET ZTDESC="UPDATE DIABETES SYSTEM TAXONOMIES"
- +13 DO ^BDMFZIS
- +14 QUIT
- TAXSET ;EP;TO UPDATE DIABETES SYSTEM STANDARD TAXONOMIES
- +1 DO T1
- +2 KILL ^TMP("TAXONOMIES")
- +3 QUIT
- T1 KILL BDMDA,BDMQUIT
- +1 ;Removed Code from 2.0 Dist
- +2 QUIT
- DX IF $PIECE(Z,";;",2)=11
- Begin DoDot:1
- +1 IF '$DATA(^ATXAX(BDMDA,11,$PIECE(Z,";;",4),0))
- Begin DoDot:2
- +2 SET ^ATXAX(BDMDA,11,$PIECE(Z,";;",4),0)=$PIECE(Z,";;",5)
- +3 SET ^ATXAX(BDMDA,11,0)="^^"_$PIECE(Z,";;",4)_"^"_$PIECE(Z,";;",4)_"^"_DT
- +4 IF '$DATA(ZTQUEUED)
- USE IO
- WRITE !,"FILE DX DESCRIPTION: ",Z
- End DoDot:2
- End DoDot:1
- +5 IF $PIECE(Z,";;",2)=21
- Begin DoDot:1
- +6 SET X=$PIECE(Z,";;",6)
- +7 IF X=""
- SET X=$PIECE(Z,";;",5)
- +8 IF X=""
- QUIT
- +9 SET YY=$PIECE(X,U)
- SET ZZ=$PIECE(X,U,2)
- +10 IF YY]""
- IF "^9999999.31^80^80.1^"'[(U_BDMFILE_U)
- Begin DoDot:2
- +11 SET YYY=$GET(^DIC(BDMFILE,0,"GL"))
- +12 IF YYY=""
- QUIT
- +13 IF BDMFILE=50
- IF $PIECE(Z,";;",10)]""
- SET YY=$PIECE(Z,";;",10)
- SET YY=$TRANSLATE(YY,"-","")
- SET YY=$ORDER(^PSDRUG("ZNDC",YY,0))
- IF $DATA(^PSDRUG(+YY,0))
- QUIT
- +14 SET YY=$PIECE(X,U)
- +15 SET YY=$ORDER(@(YYY_"""B"","""_YY_""",0)"))
- +16 IF ZZ]""
- SET ZZ=$ORDER(@(YYY_"""B"","""_ZZ_""",0)"))
- End DoDot:2
- IF 'YY
- QUIT
- +17 IF ZZ=""
- SET ZZ=YY
- +18 IF $DATA(^ATXAX(BDMDA,21,"B",YY))
- QUIT
- +19 IF '$DATA(ZTQUEUED)
- USE IO
- WRITE !?10,"FILE DX ITEM: ",X," ",YY," ",ZZ
- +20 SET X=YY
- +21 SET DA=BDMDA
- +22 SET DA(1)=BDMDA
- +23 SET DIC="^ATXAX("_DA_",21,"
- +24 IF $GET(ZZ)]""
- SET DIC("DR")=".02////"_ZZ
- KILL ZZ
- +25 IF '$DATA(^ATXAX(DA,21,0))
- SET ^ATXAX(DA,21,0)="^9002226.02101A"
- +26 SET DIC(0)="L"
- +27 DO FILE^BDMFDIC
- End DoDot:1
- +28 QUIT
- LAB IF $PIECE(Z,";;",2)=11
- Begin DoDot:1
- +1 IF '$DATA(^ATXLAB(BDMDA,11,$PIECE(Z,";;",4),0))
- Begin DoDot:2
- +2 SET ^ATXLAB(BDMDA,11,$PIECE(Z,";;",4),0)=$PIECE(Z,";;",5)
- +3 SET ^ATXLAB(BDMDA,11,0)="^^"_$PIECE(Z,";;",4)_"^"_$PIECE(Z,";;",4)_"^"_DT
- +4 IF '$DATA(ZTQUEUED)
- USE IO
- WRITE !,"FILE LAB DESCRIPTION: ",Z
- End DoDot:2
- End DoDot:1
- QUIT
- +5 IF $PIECE(Z,";;",2)=21
- IF $PIECE(Z,";;",6)'="SOURCE"
- Begin DoDot:1
- +6 SET YY=$PIECE(Z,";;",5)
- +7 IF $PIECE($GET(^LAB(60,YY,0)),U,12)=$PIECE(Z,";;",7)
- +8 IF '$TEST
- Begin DoDot:2
- +9 SET YY=$PIECE(Z,";;",6)
- +10 IF YY=""
- QUIT
- +11 SET YY=$ORDER(^LAB(60,"B",YY,0))
- +12 IF 'YY
- IF $DATA(^LAB(60,+$PIECE(Z,";;",5),0))
- IF $EXTRACT($PIECE(^(0),U),1,5)=$EXTRACT($PIECE(Z,";;",6),1,5)
- SET YY=$PIECE(Z,";;",5)
- End DoDot:2
- +13 IF 'YY
- QUIT
- +14 IF '$DATA(^LAB(60,YY,0))
- QUIT
- +15 SET BDMDA(1)=BDMDA
- +16 IF $DATA(^ATXLAB(BDMDA,21,"B",YY))
- QUIT
- +17 IF '$DATA(ZTQUEUED)
- USE IO
- WRITE !?10,"FILE LAB ITEM: ",YY
- +18 SET X=YY
- +19 SET DA=BDMDA
- +20 SET DA(1)=BDMDA
- +21 SET DIC="^ATXLAB("_DA_",21,"
- +22 SET DIC(0)="L"
- +23 IF '$DATA(^ATXLAB(DA,21,0))
- SET ^ATXLAB(DA,21,0)="^9002228.02101PA"
- +24 DO FILE^BDMFDIC
- +25 SET BDMDA(1)=+Y
- End DoDot:1
- +26 IF $GET(BDMDA)
- IF $GET(BDMDA(1))
- IF $PIECE(Z,";;",2)=21
- IF $PIECE(Z,";;",6)="SOURCE"
- Begin DoDot:1
- +27 IF $DATA(^ATXLAB(BDMDA,21,BDMDA(1)))
- IF '$DATA(^ATXLAB(BDMDA,21,BDMDA(1),11,$PIECE(Z,";;",5),0))
- Begin DoDot:2
- +28 SET ^ATXLAB(BDMDA,21,BDMDA(1),11,$PIECE(Z,";;",5),0)=$PIECE(Z,";;",7)
- +29 IF '$DATA(ZTQUEUED)
- USE IO
- WRITE !?10,"FILE LAB ITEM SOURCE: ",Z
- End DoDot:2
- End DoDot:1
- +30 QUIT
