BWMDEX1.m

BWMDEX1 ;IHS/CIA/DKM - Convert MDE data to export format;21-Oct-2003 10:03;PLS

 ;;2.0;WOMEN'S HEALTH;**9**;MAY 16, 1996

EXPORT(BWFMT,BWIEN,BWGBL,BWNEW) ; EP

 N BWDATA,BWLN,BWSEQ,BWDFN,BWFAC,BWPT,BWDT,BWPAP,BWMAM,BWX,X,Y,Z,P

 K:$G(BWNEW) @BWGBL

 ; Load formatting information into BWFMT if not already done.

 I $D(BWFMT)<10 D

 .S X=0,BWFMT("LN")=+$P(^BWFMT(BWFMT,0),U,2)

 .F  S X=$O(^BWFMT(BWFMT,1,X)) Q:'X  S Y=^(X,0) D

 ..S BWSEQ=$P(Y,U,7)*1000000+X

 ..F Z=2:1:9 S BWFMT(BWSEQ,Z)=$P(Y,U,Z)

 ..S:'$L(BWFMT(BWSEQ,8)) BWFMT(BWSEQ,8)=" "

 ..S BWFMT(BWSEQ,"PX")=$G(^BWFMT(BWFMT,1,X,1)),BWFMT(BWSEQ,"SX")=$G(^(2)),BWFMT(BWSEQ,"TX")=$G(^(3)),BWFMT(BWSEQ,"SC")=$G(^(4))

 ..M BWFMT(BWSEQ,"PR")=^BWFMT(BWFMT,1,X,20,"B")

 ..K:BWFMT(BWSEQ,9)!'$L(BWFMT(BWSEQ,"TX")) BWFMT(BWSEQ)

 ; Now loop through formatting data

 D LOADDATA^BWMDEX(BWIEN)

 S BWLN=+$O(@BWGBL@(""),-1),(BWSEQ,BWX)="",$E(BWX,BWFMT("LN"))=" "

 F  S BWSEQ=$O(BWFMT(BWSEQ)) Q:BWSEQ'=+BWSEQ  D

 .I $D(BWFMT(BWSEQ,"PR"))>1,'$D(BWFMT(BWSEQ,"PR",BWPT)) Q

 .I $L(BWFMT(BWSEQ,"SC")) X BWFMT(BWSEQ,"SC") Q:'$T

 .K X

 .X BWFMT(BWSEQ,"TX")

 .S Z=$L($G(X))

 .Q:'Z

 .S:$L(BWFMT(BWSEQ,2)) BWDATA(BWFMT(BWSEQ,2))=X

 .S Y=BWFMT(BWSEQ,4)

 .I Y,Y'=Z D

 ..I Z>Y S X=$E(X,1,Y)

 ..E  S Z=BWFMT(BWSEQ,6),P=BWFMT(BWSEQ,8),X=$S(Z=1:$$RJ^XLFSTR(X,Y,P),Z=2:$$LJ^XLFSTR(X,Y,P),Z=3:$$CJ^XLFSTR(X,Y,P),1:X)

 .S:$L(X) X=BWFMT(BWSEQ,"PX")_X_BWFMT(BWSEQ,"SX")

 .S Y=BWFMT(BWSEQ,3)

 .I Y S $E(BWX,Y,Y+$L(X)-1)=X

 .E  S BWX=BWX_X

 .D:BWFMT(BWSEQ,5) OUTLN

OUTLN S:$L(BWX) BWLN=BWLN+1,@BWGBL@(BWLN)=BWX

 S BWX="",$E(BWX,BWFMT("LN"))=" "

 Q

 ; Return data from specified node and piece

PC(BWN,BWP,BWT) ;

 Q $$PC^BWMDEX(.BWN,.BWP,.BWT)

 ; Open HFS device

 ; .BWFILE = Name of host file (use default if not specified)

 ; .BWPATH = Returned as the path to the host file

 ;  BWTST  = If nonzero, close host file after successful open.

HFSOPEN(BWFILE,BWPATH,BWTST) ; EP

 D GETFILE(.BWPATH,.BWFILE)

 I 'BWPOP D

 .S BWPOP=$$OPEN^%ZISH(BWPATH,BWFILE,"W")

 .I 'BWPOP,$G(BWTST) D ^%ZISC

 .I BWPOP,'$D(BWSILENT) D

 ..W !!?5,"* Save to Host File Server FAILED. Contact your site manager."

 ..D DIRZ^BWUTLP

 ;IHS exemption approved on 10/20/2003

 Q:$Q BWPOP

 Q

 ; Return output filename and path

GETFILE(BWPATH,BWFILE) ;

 N X

 S X=$G(^BWSITE(DUZ(2),0)),BWPATH=$P(X,U,14)

 I '$L(BWPATH) D

 .S BWPOP=1

 .W:'$D(BWSILENT) !!?5,"* No path defined in site file.  Contact your site manager."

 I '$D(BWFILE) D

 .S BWFILE=$P(X,U,13)_$E(DT,4,5)_$E(DT,2,3)_$S('$G(BWADHOC):$$CDCVER^BWMDEX2,1:"LC")

 .S:'$D(BWSILENT) BWFILE=$$DIR^BWUTLP("F","Name of output file",BWFILE,"Name of file to receive output.",.BWPOP)

 Q

 ; Send extract results to output device

OUTPUT(BWGBL,BWADHOC,BWFILE) ; EP

 N BWCOUNT,BWHFS,BWPATH,X

 I '$D(@BWGBL) D:'$D(BWSILENT)  Q

 .W !!?5,"No records to be exported."

 .D DIRZ^BWUTLP

 ;

 ; If this is an adhoc query then offer to write file out to alternate device.

 I '$D(BWSILENT),BWADHOC D  Q:BWPOP

 .W !!,"Do you wish to save your results to a file or send them to"

 .W !,"an alternate device?"

 .S BWHFS=$$DIR^BWUTLP("SA^0:OTHER;1:FILE","Select FILE or OTHER: ","FILE",1,.BWPOP)

 E  S BWHFS=1

 I BWHFS D

 .D HFSOPEN(.BWFILE,.BWPATH)

 E  D

 .D ^%ZIS

 .S BWPOP=POP

 Q:BWPOP

 U IO

 S (X,BWCOUNT)=0

 F BWCOUNT=0:1 S X=$O(@BWGBL@(X)) Q:'X  W @BWGBL@(X),!

 D ^%ZISC

 D:BWHFS SHOWDLG^BWUTLP(12_U_BWFILE_U_BWPATH)

 ; Offer to log if not an ad hoc extract

 I 'BWADHOC D

 .I '$D(BWSILENT),'$$DIRYN^BWUTLP(6,"YES",7) Q

 .D FILE^BWFMAN(9002086.92,".02////"_BWCOUNT_";.03////"_BWPATH_BWFILE,"ML",DT,9002086,.X)

 .D:X<0 SHOWDLG^BWUTLP(-5)

 Q

BWMDEX1   ;IHS/CIA/DKM - Convert MDE data to export format;21-Oct-2003 10:03;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**9**;MAY 16, 1996

EXPORT(BWFMT,BWIEN,BWGBL,BWNEW) ; EP

 +1        NEW BWDATA,BWLN,BWSEQ,BWDFN,BWFAC,BWPT,BWDT,BWPAP,BWMAM,BWX,X,Y,Z,P

 +2        IF $GET(BWNEW)

               KILL @BWGBL

 +3       ; Load formatting information into BWFMT if not already done.

 +4        IF $DATA(BWFMT)<10

               Begin DoDot:1

 +5                SET X=0

                   SET BWFMT("LN")=+$PIECE(^BWFMT(BWFMT,0),U,2)

 +6                FOR 

                       SET X=$ORDER(^BWFMT(BWFMT,1,X))

                       IF 'X

                           QUIT 

                       SET Y=^(X,0)

                       Begin DoDot:2

 +7                        SET BWSEQ=$PIECE(Y,U,7)*1000000+X

 +8                        FOR Z=2:1:9

                               SET BWFMT(BWSEQ,Z)=$PIECE(Y,U,Z)

 +9                        IF '$LENGTH(BWFMT(BWSEQ,8))

                               SET BWFMT(BWSEQ,8)=" "

 +10                       SET BWFMT(BWSEQ,"PX")=$GET(^BWFMT(BWFMT,1,X,1))

                           SET BWFMT(BWSEQ,"SX")=$GET(^(2))

                           SET BWFMT(BWSEQ,"TX")=$GET(^(3))

                           SET BWFMT(BWSEQ,"SC")=$GET(^(4))

 +11                       MERGE BWFMT(BWSEQ,"PR")=^BWFMT(BWFMT,1,X,20,"B")

 +12                       IF BWFMT(BWSEQ,9)!'$LENGTH(BWFMT(BWSEQ,"TX"))

                               KILL BWFMT(BWSEQ)

                       End DoDot:2

               End DoDot:1

 +13      ; Now loop through formatting data

 +14       DO LOADDATA^BWMDEX(BWIEN)

 +15       SET BWLN=+$ORDER(@BWGBL@(""),-1)

           SET (BWSEQ,BWX)=""

           SET $EXTRACT(BWX,BWFMT("LN"))=" "

 +16       FOR 

               SET BWSEQ=$ORDER(BWFMT(BWSEQ))

               IF BWSEQ'=+BWSEQ

                   QUIT 

               Begin DoDot:1

 +17               IF $DATA(BWFMT(BWSEQ,"PR"))>1

                       IF '$DATA(BWFMT(BWSEQ,"PR",BWPT))

                           QUIT 

 +18               IF $LENGTH(BWFMT(BWSEQ,"SC"))

                       XECUTE BWFMT(BWSEQ,"SC")

                       IF '$TEST

                           QUIT 

 +19               KILL X

 +20               XECUTE BWFMT(BWSEQ,"TX")

 +21               SET Z=$LENGTH($GET(X))

 +22               IF 'Z

                       QUIT 

 +23               IF $LENGTH(BWFMT(BWSEQ,2))

                       SET BWDATA(BWFMT(BWSEQ,2))=X

 +24               SET Y=BWFMT(BWSEQ,4)

 +25               IF Y

                       IF Y'=Z

                           Begin DoDot:2

 +26                           IF Z>Y

                                   SET X=$EXTRACT(X,1,Y)

 +27                          IF '$TEST

                                   SET Z=BWFMT(BWSEQ,6)

                                   SET P=BWFMT(BWSEQ,8)

                                   SET X=$SELECT(Z=1:$$RJ^XLFSTR(X,Y,P),Z=2:$$LJ^XLFSTR(X,Y,P),Z=3:$$CJ^XLFSTR(X,Y,P),1:X)

                           End DoDot:2

 +28               IF $LENGTH(X)

                       SET X=BWFMT(BWSEQ,"PX")_X_BWFMT(BWSEQ,"SX")

 +29               SET Y=BWFMT(BWSEQ,3)

 +30               IF Y

                       SET $EXTRACT(BWX,Y,Y+$LENGTH(X)-1)=X

 +31              IF '$TEST

                       SET BWX=BWX_X

 +32               IF BWFMT(BWSEQ,5)

                       DO OUTLN

               End DoDot:1

OUTLN      IF $LENGTH(BWX)

               SET BWLN=BWLN+1

               SET @BWGBL@(BWLN)=BWX

 +1        SET BWX=""

           SET $EXTRACT(BWX,BWFMT("LN"))=" "

 +2        QUIT 

 +3       ; Return data from specified node and piece

PC(BWN,BWP,BWT) ;

 +1        QUIT $$PC^BWMDEX(.BWN,.BWP,.BWT)

 +2       ; Open HFS device

 +3       ; .BWFILE = Name of host file (use default if not specified)

 +4       ; .BWPATH = Returned as the path to the host file

 +5       ;  BWTST  = If nonzero, close host file after successful open.

HFSOPEN(BWFILE,BWPATH,BWTST) ; EP

 +1        DO GETFILE(.BWPATH,.BWFILE)

 +2        IF 'BWPOP

               Begin DoDot:1

 +3                SET BWPOP=$$OPEN^%ZISH(BWPATH,BWFILE,"W")

 +4                IF 'BWPOP

                       IF $GET(BWTST)

                           DO ^%ZISC

 +5                IF BWPOP

                       IF '$DATA(BWSILENT)

                           Begin DoDot:2

 +6                            WRITE !!?5,"* Save to Host File Server FAILED. Contact your site manager."

 +7                            DO DIRZ^BWUTLP

                           End DoDot:2

               End DoDot:1

 +8       ;IHS exemption approved on 10/20/2003

 +9        IF $QUIT

               QUIT BWPOP

 +10       QUIT 

 +11      ; Return output filename and path

GETFILE(BWPATH,BWFILE) ;

 +1        NEW X

 +2        SET X=$GET(^BWSITE(DUZ(2),0))

           SET BWPATH=$PIECE(X,U,14)

 +3        IF '$LENGTH(BWPATH)

               Begin DoDot:1

 +4                SET BWPOP=1

 +5                IF '$DATA(BWSILENT)

                       WRITE !!?5,"* No path defined in site file.  Contact your site manager."

               End DoDot:1

 +6        IF '$DATA(BWFILE)

               Begin DoDot:1

 +7                SET BWFILE=$PIECE(X,U,13)_$EXTRACT(DT,4,5)_$EXTRACT(DT,2,3)_$SELECT('$GET(BWADHOC):$$CDCVER^BWMDEX2,1:"LC")

 +8                IF '$DATA(BWSILENT)

                       SET BWFILE=$$DIR^BWUTLP("F","Name of output file",BWFILE,"Name of file to receive output.",.BWPOP)

               End DoDot:1

 +9        QUIT 

 +10      ; Send extract results to output device

OUTPUT(BWGBL,BWADHOC,BWFILE) ; EP

 +1        NEW BWCOUNT,BWHFS,BWPATH,X

 +2        IF '$DATA(@BWGBL)

               IF '$DATA(BWSILENT)

                   Begin DoDot:1

 +3                    WRITE !!?5,"No records to be exported."

 +4                    DO DIRZ^BWUTLP

                   End DoDot:1

               QUIT 

 +5       ;

 +6       ; If this is an adhoc query then offer to write file out to alternate device.

 +7        IF '$DATA(BWSILENT)

               IF BWADHOC

                   Begin DoDot:1

 +8                    WRITE !!,"Do you wish to save your results to a file or send them to"

 +9                    WRITE !,"an alternate device?"

 +10                   SET BWHFS=$$DIR^BWUTLP("SA^0:OTHER;1:FILE","Select FILE or OTHER: ","FILE",1,.BWPOP)

                   End DoDot:1

                   IF BWPOP

                       QUIT 

 +11      IF '$TEST

               SET BWHFS=1

 +12       IF BWHFS

               Begin DoDot:1

 +13               DO HFSOPEN(.BWFILE,.BWPATH)

               End DoDot:1

 +14      IF '$TEST

               Begin DoDot:1

 +15               DO ^%ZIS

 +16               SET BWPOP=POP

               End DoDot:1

 +17       IF BWPOP

               QUIT 

 +18       USE IO

 +19       SET (X,BWCOUNT)=0

 +20       FOR BWCOUNT=0:1

               SET X=$ORDER(@BWGBL@(X))

               IF 'X

                   QUIT 

               WRITE @BWGBL@(X),!

 +21       DO ^%ZISC

 +22       IF BWHFS

               DO SHOWDLG^BWUTLP(12_U_BWFILE_U_BWPATH)

 +23      ; Offer to log if not an ad hoc extract

 +24       IF 'BWADHOC

               Begin DoDot:1

 +25               IF '$DATA(BWSILENT)

                       IF '$$DIRYN^BWUTLP(6,"YES",7)

                           QUIT 

 +26               DO FILE^BWFMAN(9002086.92,".02////"_BWCOUNT_";.03////"_BWPATH_BWFILE,"ML",DT,9002086,.X)

 +27               IF X<0

                       DO SHOWDLG^BWUTLP(-5)

               End DoDot:1

 +28       QUIT